RPC Server #103
10 changed files with 819 additions and 770 deletions
|
|
@ -22,6 +22,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
|||
- `getoperationstatus` RPC method
|
||||
- `sendmany` RPC method
|
||||
- Function `prepareTxV2` implementing `PrivacyPolicy`
|
||||
- Functionality to shield transparent balance
|
||||
- Functionality to de-shield shielded notes
|
||||
|
||||
### Changed
|
||||
|
||||
|
|
|
|||
|
|
@ -832,7 +832,7 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
||||
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
|
||||
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
|
||||
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort znet dbBlock 1
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
|
||||
|
|
@ -840,11 +840,12 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
logDebugN $
|
||||
"dbBlock: " <>
|
||||
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
||||
when (chkBlock /= dbBlock) $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
when (chkBlock /= dbBlock && chkBlock /= 1) $
|
||||
rewindWalletData pool sb $ ZcashNetDB znet
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then do
|
||||
liftIO $
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ import Data.Aeson
|
|||
import Data.Binary.Get hiding (getBytes)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.HexString (HexString, toBytes)
|
||||
import Data.HexString (HexString, hexBytes, hexString, toBytes, toText)
|
||||
import Data.Int (Int64)
|
||||
import Data.List
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
|
|
@ -116,20 +116,35 @@ checkBlockChain nodeHost nodePort = do
|
|||
|
||||
-- | Get commitment trees from Zebra
|
||||
getCommitmentTrees ::
|
||||
T.Text -- ^ Host where `zebrad` is avaiable
|
||||
ConnectionPool
|
||||
-> T.Text -- ^ Host where `zebrad` is avaiable
|
||||
-> Int -- ^ Port where `zebrad` is available
|
||||
-> ZcashNetDB
|
||||
-> Int -- ^ Block height
|
||||
-> IO ZebraTreeInfo
|
||||
getCommitmentTrees nodeHost nodePort block = do
|
||||
r <-
|
||||
makeZebraCall
|
||||
nodeHost
|
||||
nodePort
|
||||
"z_gettreestate"
|
||||
[Data.Aeson.String $ T.pack $ show block]
|
||||
case r of
|
||||
Left e -> throwIO $ userError e
|
||||
Right zti -> return zti
|
||||
getCommitmentTrees pool nodeHost nodePort znet block = do
|
||||
bh' <- getBlockHash pool block znet
|
||||
case bh' of
|
||||
Nothing -> do
|
||||
r <-
|
||||
makeZebraCall
|
||||
nodeHost
|
||||
nodePort
|
||||
"z_gettreestate"
|
||||
[Data.Aeson.String $ T.pack $ show block]
|
||||
case r of
|
||||
Left e -> throwIO $ userError e
|
||||
Right zti -> return zti
|
||||
Just bh -> do
|
||||
r <-
|
||||
makeZebraCall
|
||||
nodeHost
|
||||
nodePort
|
||||
"z_gettreestate"
|
||||
[Data.Aeson.String $ toText bh]
|
||||
case r of
|
||||
Left e -> throwIO $ userError e
|
||||
Right zti -> return zti
|
||||
|
||||
-- * Spending Keys
|
||||
-- | Create an Orchard Spending Key for the given wallet and account index
|
||||
|
|
@ -288,7 +303,7 @@ findSaplingOutputs config b znet za = do
|
|||
let zn = getNet znet
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
tList <- liftIO $ getShieldedOutputs pool b znet
|
||||
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort (b - 1)
|
||||
trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort znet (b - 1)
|
||||
logDebugN "getting Sapling frontier"
|
||||
let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees
|
||||
case sT of
|
||||
|
|
@ -395,7 +410,7 @@ findOrchardActions config b znet za = do
|
|||
let zn = getNet znet
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
tList <- getOrchardActions pool b znet
|
||||
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
||||
trees <- getCommitmentTrees pool zebraHost zebraPort znet (b - 1)
|
||||
let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees
|
||||
case sT of
|
||||
Nothing -> throwIO $ userError "Failed to read Orchard commitment tree"
|
||||
|
|
@ -507,264 +522,271 @@ updateOrchardWitnesses pool = do
|
|||
-- | Calculate fee per ZIP-317
|
||||
calculateTxFee ::
|
||||
([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
|
||||
-> Int
|
||||
-> Integer
|
||||
calculateTxFee (t, s, o) i =
|
||||
fromIntegral
|
||||
(5000 * (max (length t) tout + max (length s) sout + length o + oout))
|
||||
-> [OutgoingNote]
|
||||
-> Int64
|
||||
calculateTxFee (t, s, o) nout =
|
||||
fromIntegral $ 5000 * (tcount + saction + oaction)
|
||||
where
|
||||
tout =
|
||||
if i == 1 || i == 2
|
||||
then 1
|
||||
else 0
|
||||
sout =
|
||||
if i == 3
|
||||
then 1
|
||||
else 0
|
||||
oout =
|
||||
if i == 4
|
||||
then 1
|
||||
else 0
|
||||
length $
|
||||
filter
|
||||
(\(OutgoingNote x _ _ _ _ _) -> x == 1 || x == 2 || x == 5 || x == 6)
|
||||
nout
|
||||
sout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 3) nout
|
||||
oout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 4) nout
|
||||
tcount = max (length t) tout
|
||||
scount = max (length s) sout
|
||||
ocount = max (length o) oout
|
||||
saction =
|
||||
if scount == 1
|
||||
then 2
|
||||
else scount
|
||||
oaction =
|
||||
if ocount == 1
|
||||
then 2
|
||||
else ocount
|
||||
|
||||
-- | Prepare a transaction for sending
|
||||
prepareTx ::
|
||||
ConnectionPool
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Scientific
|
||||
-> UnifiedAddress
|
||||
-> T.Text
|
||||
-> LoggingT IO (Either TxError HexString)
|
||||
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
||||
accRead <- liftIO $ getAccountById pool za
|
||||
let recipient =
|
||||
case o_rec ua of
|
||||
Nothing ->
|
||||
case s_rec ua of
|
||||
Nothing ->
|
||||
case t_rec ua of
|
||||
Nothing -> (0, "")
|
||||
Just r3 ->
|
||||
case tr_type r3 of
|
||||
P2PKH -> (1, toBytes $ tr_bytes r3)
|
||||
P2SH -> (2, toBytes $ tr_bytes r3)
|
||||
Just r2 -> (3, getBytes r2)
|
||||
Just r1 -> (4, getBytes r1)
|
||||
logDebugN $ T.pack $ show recipient
|
||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
case accRead of
|
||||
Nothing -> do
|
||||
logErrorN "Can't find Account"
|
||||
return $ Left ZHError
|
||||
Just acc -> do
|
||||
logDebugN $ T.pack $ show acc
|
||||
let zats' = toBoundedInteger $ amt * scientific 1 8
|
||||
case zats' of
|
||||
Nothing -> return $ Left ZHError
|
||||
Just zats -> do
|
||||
logDebugN $ T.pack $ show (zats :: Int64)
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--let fee = calculateTxFee firstPass $ fst recipient
|
||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
(tList, sList, oList) <-
|
||||
liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
|
||||
logDebugN "selected notes"
|
||||
logDebugN $ T.pack $ show tList
|
||||
logDebugN $ T.pack $ show sList
|
||||
logDebugN $ T.pack $ show oList
|
||||
let noteTotal = getTotalAmount (tList, sList, oList)
|
||||
tSpends <-
|
||||
liftIO $
|
||||
prepTSpends
|
||||
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
||||
tList
|
||||
--print tSpends
|
||||
sSpends <-
|
||||
liftIO $
|
||||
prepSSpends
|
||||
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||
sList
|
||||
--print sSpends
|
||||
oSpends <-
|
||||
liftIO $
|
||||
prepOSpends
|
||||
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
oList
|
||||
--print oSpends
|
||||
dummy <-
|
||||
liftIO $
|
||||
makeOutgoing
|
||||
acc
|
||||
recipient
|
||||
zats
|
||||
(fromInteger noteTotal - 5000 - zats)
|
||||
logDebugN "Calculating fee"
|
||||
let feeResponse =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
dummy
|
||||
zn
|
||||
bh
|
||||
False
|
||||
case feeResponse of
|
||||
Left e1 -> return $ Left Fee
|
||||
Right fee -> do
|
||||
let feeAmt =
|
||||
fromIntegral
|
||||
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||
(tList1, sList1, oList1) <-
|
||||
liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
|
||||
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
|
||||
logDebugN $ T.pack $ show tList
|
||||
logDebugN $ T.pack $ show sList
|
||||
logDebugN $ T.pack $ show oList
|
||||
outgoing <-
|
||||
liftIO $
|
||||
makeOutgoing
|
||||
acc
|
||||
recipient
|
||||
zats
|
||||
(fromInteger noteTotal - fromInteger feeAmt - zats)
|
||||
logDebugN $ T.pack $ show outgoing
|
||||
let tx =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
outgoing
|
||||
zn
|
||||
bh
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
where
|
||||
makeOutgoing ::
|
||||
Entity ZcashAccount
|
||||
-> (Int, BS.ByteString)
|
||||
-> Int64
|
||||
-> Int64
|
||||
-> IO [OutgoingNote]
|
||||
makeOutgoing acc (k, recvr) zats chg = do
|
||||
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||
let chgRcvr =
|
||||
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
return
|
||||
[ OutgoingNote
|
||||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
, OutgoingNote
|
||||
(fromIntegral k)
|
||||
(case k of
|
||||
4 ->
|
||||
getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
|
||||
3 ->
|
||||
getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
|
||||
_ -> "")
|
||||
recvr
|
||||
(fromIntegral zats)
|
||||
(E.encodeUtf8 memo)
|
||||
False
|
||||
]
|
||||
getTotalAmount ::
|
||||
( [Entity WalletTrNote]
|
||||
, [Entity WalletSapNote]
|
||||
, [Entity WalletOrchNote])
|
||||
-> Integer
|
||||
getTotalAmount (t, s, o) =
|
||||
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
|
||||
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
|
||||
sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
|
||||
prepTSpends ::
|
||||
TransparentSpendingKey
|
||||
-> [Entity WalletTrNote]
|
||||
-> IO [TransparentTxSpend]
|
||||
prepTSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
|
||||
case tAddRead of
|
||||
Nothing -> throwIO $ userError "Couldn't read t-address"
|
||||
Just tAdd -> do
|
||||
(XPrvKey _ _ _ _ (SecKey xp_key)) <-
|
||||
genTransparentSecretKey
|
||||
(walletAddressIndex $ entityVal tAdd)
|
||||
(getScope $ walletAddressScope $ entityVal tAdd)
|
||||
sk
|
||||
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
|
||||
case mReverseTxId of
|
||||
Nothing -> throwIO $ userError "failed to get tx ID"
|
||||
Just (ESQ.Value reverseTxId) -> do
|
||||
let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
|
||||
return $
|
||||
TransparentTxSpend
|
||||
xp_key
|
||||
(RawOutPoint
|
||||
flipTxId
|
||||
(fromIntegral $ walletTrNotePosition $ entityVal n))
|
||||
(RawTxOut
|
||||
(fromIntegral $ walletTrNoteValue $ entityVal n)
|
||||
(walletTrNoteScript $ entityVal n))
|
||||
prepSSpends ::
|
||||
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
|
||||
prepSSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
return $
|
||||
SaplingTxSpend
|
||||
(getBytes sk)
|
||||
(DecodedNote
|
||||
(fromIntegral $ walletSapNoteValue $ entityVal n)
|
||||
(walletSapNoteRecipient $ entityVal n)
|
||||
(E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
|
||||
(getHex $ walletSapNoteNullifier $ entityVal n)
|
||||
""
|
||||
(getRseed $ walletSapNoteRseed $ entityVal n))
|
||||
(toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
|
||||
prepOSpends ::
|
||||
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
|
||||
prepOSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
return $
|
||||
OrchardTxSpend
|
||||
(getBytes sk)
|
||||
(DecodedNote
|
||||
(fromIntegral $ walletOrchNoteValue $ entityVal n)
|
||||
(walletOrchNoteRecipient $ entityVal n)
|
||||
(E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
|
||||
(getHex $ walletOrchNoteNullifier $ entityVal n)
|
||||
(walletOrchNoteRho $ entityVal n)
|
||||
(getRseed $ walletOrchNoteRseed $ entityVal n))
|
||||
(toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
|
||||
sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
|
||||
sapAnchor notes =
|
||||
if not (null notes)
|
||||
then Just $
|
||||
SaplingWitness $
|
||||
getHex $ walletSapNoteWitness $ entityVal $ head notes
|
||||
else Nothing
|
||||
orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
|
||||
orchAnchor notes =
|
||||
if not (null notes)
|
||||
then Just $
|
||||
OrchardWitness $
|
||||
getHex $ walletOrchNoteWitness $ entityVal $ head notes
|
||||
else Nothing
|
||||
|
||||
{-
|
||||
-prepareTx ::
|
||||
- ConnectionPool
|
||||
- -> T.Text
|
||||
- -> Int
|
||||
- -> ZcashNet
|
||||
- -> ZcashAccountId
|
||||
- -> Int
|
||||
- -> Scientific
|
||||
- -> UnifiedAddress
|
||||
- -> T.Text
|
||||
- -> LoggingT IO (Either TxError HexString)
|
||||
-prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
||||
- accRead <- liftIO $ getAccountById pool za
|
||||
- let recipient =
|
||||
- case o_rec ua of
|
||||
- Nothing ->
|
||||
- case s_rec ua of
|
||||
- Nothing ->
|
||||
- case t_rec ua of
|
||||
- Nothing -> (0, "")
|
||||
- Just r3 ->
|
||||
- case tr_type r3 of
|
||||
- P2PKH -> (1, toBytes $ tr_bytes r3)
|
||||
- P2SH -> (2, toBytes $ tr_bytes r3)
|
||||
- Just r2 -> (3, getBytes r2)
|
||||
- Just r1 -> (4, getBytes r1)
|
||||
- logDebugN $ T.pack $ show recipient
|
||||
- logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
- trees <-
|
||||
- liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
|
||||
- let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
- let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
- case accRead of
|
||||
- Nothing -> do
|
||||
- logErrorN "Can't find Account"
|
||||
- return $ Left ZHError
|
||||
- Just acc -> do
|
||||
- logDebugN $ T.pack $ show acc
|
||||
- let zats' = toBoundedInteger $ amt * scientific 1 8
|
||||
- case zats' of
|
||||
- Nothing -> return $ Left ZHError
|
||||
- Just zats -> do
|
||||
- logDebugN $ T.pack $ show (zats :: Int64)
|
||||
- {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
- --let fee = calculateTxFee firstPass $ fst recipient
|
||||
- --logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
- (tList, sList, oList) <-
|
||||
- liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
|
||||
- logDebugN "selected notes"
|
||||
- logDebugN $ T.pack $ show tList
|
||||
- logDebugN $ T.pack $ show sList
|
||||
- logDebugN $ T.pack $ show oList
|
||||
- let noteTotal = getTotalAmount (tList, sList, oList)
|
||||
- tSpends <-
|
||||
- liftIO $
|
||||
- prepTSpends
|
||||
- (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
||||
- tList
|
||||
- --print tSpends
|
||||
- sSpends <-
|
||||
- liftIO $
|
||||
- prepSSpends
|
||||
- (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||
- sList
|
||||
- --print sSpends
|
||||
- oSpends <-
|
||||
- liftIO $
|
||||
- prepOSpends
|
||||
- (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
- oList
|
||||
- --print oSpends
|
||||
- dummy <-
|
||||
- liftIO $
|
||||
- makeOutgoing
|
||||
- acc
|
||||
- recipient
|
||||
- zats
|
||||
- (fromInteger noteTotal - 5000 - zats)
|
||||
- logDebugN "Calculating fee"
|
||||
- let feeResponse =
|
||||
- createTransaction
|
||||
- (Just sT)
|
||||
- (Just oT)
|
||||
- tSpends
|
||||
- sSpends
|
||||
- oSpends
|
||||
- dummy
|
||||
- zn
|
||||
- bh
|
||||
- False
|
||||
- case feeResponse of
|
||||
- Left e1 -> return $ Left Fee
|
||||
- Right fee -> do
|
||||
- let feeAmt =
|
||||
- fromIntegral
|
||||
- (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||
- (tList1, sList1, oList1) <-
|
||||
- liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
|
||||
- logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
|
||||
- logDebugN $ T.pack $ show tList
|
||||
- logDebugN $ T.pack $ show sList
|
||||
- logDebugN $ T.pack $ show oList
|
||||
- outgoing <-
|
||||
- liftIO $
|
||||
- makeOutgoing
|
||||
- acc
|
||||
- recipient
|
||||
- zats
|
||||
- (fromInteger noteTotal - fromInteger feeAmt - zats)
|
||||
- logDebugN $ T.pack $ show outgoing
|
||||
- let tx =
|
||||
- createTransaction
|
||||
- (Just sT)
|
||||
- (Just oT)
|
||||
- tSpends
|
||||
- sSpends
|
||||
- oSpends
|
||||
- outgoing
|
||||
- zn
|
||||
- bh
|
||||
- True
|
||||
- logDebugN $ T.pack $ show tx
|
||||
- return tx
|
||||
- where
|
||||
- makeOutgoing ::
|
||||
- Entity ZcashAccount
|
||||
- -> (Int, BS.ByteString)
|
||||
- -> Int64
|
||||
- -> Int64
|
||||
- -> IO [OutgoingNote]
|
||||
- makeOutgoing acc (k, recvr) zats chg = do
|
||||
- chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||
- let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||
- let chgRcvr =
|
||||
- fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
- return
|
||||
- [ OutgoingNote
|
||||
- 4
|
||||
- (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
- (getBytes chgRcvr)
|
||||
- (fromIntegral chg)
|
||||
- ""
|
||||
- True
|
||||
- , OutgoingNote
|
||||
- (fromIntegral k)
|
||||
- (case k of
|
||||
- 4 ->
|
||||
- getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
|
||||
- 3 ->
|
||||
- getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
|
||||
- _ -> "")
|
||||
- recvr
|
||||
- (fromIntegral zats)
|
||||
- (E.encodeUtf8 memo)
|
||||
- False
|
||||
- ]
|
||||
- getTotalAmount ::
|
||||
- ( [Entity WalletTrNote]
|
||||
- , [Entity WalletSapNote]
|
||||
- , [Entity WalletOrchNote])
|
||||
- -> Integer
|
||||
- getTotalAmount (t, s, o) =
|
||||
- sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
|
||||
- sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
|
||||
- sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
|
||||
- prepTSpends ::
|
||||
- TransparentSpendingKey
|
||||
- -> [Entity WalletTrNote]
|
||||
- -> IO [TransparentTxSpend]
|
||||
- prepTSpends sk notes = do
|
||||
- forM notes $ \n -> do
|
||||
- tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
|
||||
- case tAddRead of
|
||||
- Nothing -> throwIO $ userError "Couldn't read t-address"
|
||||
- Just tAdd -> do
|
||||
- (XPrvKey _ _ _ _ (SecKey xp_key)) <-
|
||||
- genTransparentSecretKey
|
||||
- (walletAddressIndex $ entityVal tAdd)
|
||||
- (getScope $ walletAddressScope $ entityVal tAdd)
|
||||
- sk
|
||||
- mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
|
||||
- case mReverseTxId of
|
||||
- Nothing -> throwIO $ userError "failed to get tx ID"
|
||||
- Just (ESQ.Value reverseTxId) -> do
|
||||
- let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
|
||||
- return $
|
||||
- TransparentTxSpend
|
||||
- xp_key
|
||||
- (RawOutPoint
|
||||
- flipTxId
|
||||
- (fromIntegral $ walletTrNotePosition $ entityVal n))
|
||||
- (RawTxOut
|
||||
- (fromIntegral $ walletTrNoteValue $ entityVal n)
|
||||
- (walletTrNoteScript $ entityVal n))
|
||||
- prepSSpends ::
|
||||
- SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
|
||||
- prepSSpends sk notes = do
|
||||
- forM notes $ \n -> do
|
||||
- return $
|
||||
- SaplingTxSpend
|
||||
- (getBytes sk)
|
||||
- (DecodedNote
|
||||
- (fromIntegral $ walletSapNoteValue $ entityVal n)
|
||||
- (walletSapNoteRecipient $ entityVal n)
|
||||
- (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
|
||||
- (getHex $ walletSapNoteNullifier $ entityVal n)
|
||||
- ""
|
||||
- (getRseed $ walletSapNoteRseed $ entityVal n))
|
||||
- (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
|
||||
- prepOSpends ::
|
||||
- OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
|
||||
- prepOSpends sk notes = do
|
||||
- forM notes $ \n -> do
|
||||
- return $
|
||||
- OrchardTxSpend
|
||||
- (getBytes sk)
|
||||
- (DecodedNote
|
||||
- (fromIntegral $ walletOrchNoteValue $ entityVal n)
|
||||
- (walletOrchNoteRecipient $ entityVal n)
|
||||
- (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
|
||||
- (getHex $ walletOrchNoteNullifier $ entityVal n)
|
||||
- (walletOrchNoteRho $ entityVal n)
|
||||
- (getRseed $ walletOrchNoteRseed $ entityVal n))
|
||||
- (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
|
||||
- sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
|
||||
- sapAnchor notes =
|
||||
- if not (null notes)
|
||||
- then Just $
|
||||
- SaplingWitness $
|
||||
- getHex $ walletSapNoteWitness $ entityVal $ head notes
|
||||
- else Nothing
|
||||
- orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
|
||||
- orchAnchor notes =
|
||||
- if not (null notes)
|
||||
- then Just $
|
||||
- OrchardWitness $
|
||||
- getHex $ walletOrchNoteWitness $ entityVal $ head notes
|
||||
- else Nothing
|
||||
-}
|
||||
deshieldNotes ::
|
||||
ConnectionPool
|
||||
-> T.Text
|
||||
|
|
@ -811,7 +833,6 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
|||
dRecvs
|
||||
forM fNotes $ \trNotes -> do
|
||||
let noteTotal = getTotalAmount (trNotes, [], [])
|
||||
let fee = calculateTxFee (trNotes, [], []) 4
|
||||
tSpends <-
|
||||
liftIO $
|
||||
prepTSpends
|
||||
|
|
@ -823,25 +844,35 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
|||
let oRcvr =
|
||||
fromJust $
|
||||
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
let dummy =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes oRcvr)
|
||||
(fromIntegral $ noteTotal - 500)
|
||||
""
|
||||
True
|
||||
let feeAmt = calculateTxFee (trNotes, [], []) [dummy]
|
||||
let snote =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes oRcvr)
|
||||
(fromIntegral $ noteTotal - fee)
|
||||
(fromIntegral $ noteTotal - fromIntegral feeAmt)
|
||||
""
|
||||
True
|
||||
let tx =
|
||||
createTransaction
|
||||
Nothing
|
||||
Nothing
|
||||
tSpends
|
||||
[]
|
||||
[]
|
||||
[snote]
|
||||
znet
|
||||
(bh + 3)
|
||||
True
|
||||
tx <-
|
||||
liftIO $
|
||||
createTransaction
|
||||
Nothing
|
||||
Nothing
|
||||
tSpends
|
||||
[]
|
||||
[]
|
||||
[snote]
|
||||
znet
|
||||
(bh + 3)
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
where
|
||||
|
|
@ -900,11 +931,10 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
let recipients = map extractReceiver pnotes
|
||||
logDebugN $ T.pack $ show recipients
|
||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
{-
|
||||
-trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
|
||||
-let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
-let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
-}
|
||||
trees <-
|
||||
liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
case accRead of
|
||||
Nothing -> do
|
||||
logErrorN "Can't find Account"
|
||||
|
|
@ -928,7 +958,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(zats + 10000)
|
||||
(zats + 20000)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
policy
|
||||
case notePlan of
|
||||
|
|
@ -957,94 +987,74 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
oList
|
||||
--print oSpends
|
||||
dummy' <-
|
||||
draft <-
|
||||
liftIO $
|
||||
makeOutgoing
|
||||
acc
|
||||
recipients
|
||||
(noteTotal - 5000 - fromIntegral zats)
|
||||
policy
|
||||
case dummy' of
|
||||
case draft of
|
||||
Left e -> return $ Left e
|
||||
Right dummy -> do
|
||||
logDebugN "Calculating fee"
|
||||
let feeResponse =
|
||||
createTransaction
|
||||
Nothing
|
||||
Nothing
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
dummy
|
||||
zn
|
||||
bh
|
||||
False
|
||||
case feeResponse of
|
||||
Left e1 -> return $ Left Fee
|
||||
Right fee -> do
|
||||
let feeAmt =
|
||||
fromIntegral
|
||||
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||
finalNotePlan <-
|
||||
Right draftOut -> do
|
||||
let fee = calculateTxFee (tList, sList, oList) draftOut
|
||||
logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
finalNotePlan <-
|
||||
liftIO $
|
||||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(zats + fee)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
policy
|
||||
case finalNotePlan of
|
||||
Right (tList1, sList1, oList1) -> do
|
||||
logDebugN $ T.pack $ "selected notes with fee" ++ show fee
|
||||
logDebugN $ T.pack $ show tList1
|
||||
logDebugN $ T.pack $ show sList1
|
||||
logDebugN $ T.pack $ show oList1
|
||||
tSpends1 <-
|
||||
liftIO $
|
||||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(fromIntegral zats + feeAmt)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
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
|
||||
recipients
|
||||
(noteTotal1 - fee - fromIntegral zats)
|
||||
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
|
||||
recipients
|
||||
(noteTotal1 - feeAmt - fromIntegral zats)
|
||||
policy
|
||||
logDebugN $ T.pack $ show outgoing'
|
||||
case outgoing' of
|
||||
Left e -> return $ Left e
|
||||
Right outgoing -> do
|
||||
let tx =
|
||||
createTransaction
|
||||
Nothing
|
||||
Nothing
|
||||
tSpends1
|
||||
sSpends1
|
||||
oSpends1
|
||||
outgoing
|
||||
zn
|
||||
bh
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
logDebugN $ T.pack $ show outgoing'
|
||||
case outgoing' of
|
||||
Left e -> return $ Left e
|
||||
Right outgoing -> do
|
||||
tx <-
|
||||
liftIO $
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends1
|
||||
sSpends1
|
||||
oSpends1
|
||||
outgoing
|
||||
zn
|
||||
bh
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
Left e -> return $ Left e
|
||||
Left e -> do
|
||||
logErrorN $ T.pack $ show e
|
||||
return $ Left e
|
||||
|
|
@ -1360,7 +1370,7 @@ syncWallet config w = do
|
|||
let startBlock =
|
||||
if lastBlock > 0
|
||||
then lastBlock
|
||||
else zcashWalletBirthdayHeight $ entityVal w
|
||||
else 1 + zcashWalletBirthdayHeight (entityVal w)
|
||||
logDebugN $ "start block: " <> T.pack (show startBlock)
|
||||
mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
|
||||
mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
|
||||
|
|
|
|||
|
|
@ -698,22 +698,42 @@ saveAddress pool w =
|
|||
runNoLoggingT $
|
||||
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
|
||||
|
||||
-- * Block
|
||||
-- | 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
|
||||
|
||||
-- | Read a block by height
|
||||
getBlock :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashBlock))
|
||||
getBlock pool b =
|
||||
getBlock ::
|
||||
ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe (Entity ZcashBlock))
|
||||
getBlock pool b znet =
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
selectOne $ do
|
||||
bl <- from $ table @ZcashBlock
|
||||
where_ $ bl ^. ZcashBlockHeight ==. val b
|
||||
where_ $
|
||||
bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
|
||||
val znet
|
||||
pure bl
|
||||
|
||||
getBlockHash :: ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe HexString)
|
||||
getBlockHash pool b znet = do
|
||||
r <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
selectOne $ do
|
||||
bl <- from $ table @ZcashBlock
|
||||
where_ $
|
||||
bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
|
||||
val znet
|
||||
pure $ bl ^. ZcashBlockHash
|
||||
case r of
|
||||
Nothing -> return Nothing
|
||||
Just (Value h) -> return $ Just $ getHex h
|
||||
|
||||
-- | Save a transaction to the data model
|
||||
saveTransaction ::
|
||||
ConnectionPool -- ^ the database path
|
||||
|
|
@ -2648,8 +2668,8 @@ completeSync pool st = do
|
|||
return ()
|
||||
|
||||
-- | Rewind the data store to a given block height
|
||||
rewindWalletData :: ConnectionPool -> Int -> LoggingT IO ()
|
||||
rewindWalletData pool b = do
|
||||
rewindWalletData :: ConnectionPool -> Int -> ZcashNetDB -> LoggingT IO ()
|
||||
rewindWalletData pool b net = do
|
||||
logDebugN "Starting transaction rewind"
|
||||
liftIO $ clearWalletTransactions pool
|
||||
logDebugN "Completed transaction rewind"
|
||||
|
|
@ -2661,7 +2681,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
|
@ -2681,7 +2703,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
|
@ -2701,7 +2725,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
|
@ -2721,7 +2747,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
|
@ -2741,7 +2769,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
|
@ -2761,7 +2791,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
|
@ -2780,5 +2812,7 @@ rewindWalletData pool b = do
|
|||
flip PS.runSqlPool pool $ do
|
||||
delete $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
logDebugN "Completed data store rewind"
|
||||
|
|
|
|||
|
|
@ -1627,17 +1627,17 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
pool <- runNoLoggingT $ initPool dbPath
|
||||
b <- liftIO $ getMinBirthdayHeight pool
|
||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
|
||||
syncChk <- isSyncing pool
|
||||
if syncChk
|
||||
then sendMsg (ShowError "Sync already in progress")
|
||||
else do
|
||||
unless (chkBlock == dbBlock) $
|
||||
runStderrLoggingT $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
unless (chkBlock == dbBlock || chkBlock == 1) $
|
||||
runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then sendMsg (ShowError "Invalid starting block for scan")
|
||||
else do
|
||||
|
|
|
|||
|
|
@ -889,15 +889,15 @@ scanZebra dbPath zHost zPort net = do
|
|||
pool <- runNoLoggingT $ initPool dbPath
|
||||
b <- getMinBirthdayHeight pool
|
||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
|
||||
syncChk <- isSyncing pool
|
||||
unless syncChk $ do
|
||||
unless (chkBlock == dbBlock) $
|
||||
runStderrLoggingT $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
unless (chkBlock == dbBlock || chkBlock == 1) $
|
||||
runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
|
||||
unless (sb > zgb_blocks bStatus || sb < 1) $ do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
unless (null bList) $ do
|
||||
|
|
|
|||
|
|
@ -246,10 +246,11 @@ checkIntegrity ::
|
|||
T.Text -- ^ Database path
|
||||
-> T.Text -- ^ Zebra host
|
||||
-> Int -- ^ Zebra port
|
||||
-> ZcashNet -- ^ the network to scan
|
||||
-> Int -- ^ The block to start the check
|
||||
-> Int -- ^ depth
|
||||
-> IO Int
|
||||
checkIntegrity dbP zHost zPort b d =
|
||||
checkIntegrity dbP zHost zPort znet b d =
|
||||
if b < 1
|
||||
then return 1
|
||||
else do
|
||||
|
|
@ -263,10 +264,10 @@ checkIntegrity dbP zHost zPort b d =
|
|||
Left e -> throwIO $ userError e
|
||||
Right blk -> do
|
||||
pool <- runNoLoggingT $ initPool dbP
|
||||
dbBlk <- getBlock pool b
|
||||
dbBlk <- getBlock pool b $ ZcashNetDB znet
|
||||
case dbBlk of
|
||||
Nothing -> throwIO $ userError "Block mismatch, rescan needed"
|
||||
Nothing -> return 1
|
||||
Just dbBlk' ->
|
||||
if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
|
||||
then return b
|
||||
else checkIntegrity dbP zHost zPort (b - 5 * d) (d + 1)
|
||||
else checkIntegrity dbP zHost zPort znet (b - 5 * d) (d + 1)
|
||||
|
|
|
|||
758
test/Spec.hs
758
test/Spec.hs
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import Data.HexString
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Text.Encoding as E
|
||||
|
|
@ -43,7 +44,7 @@ import ZcashHaskell.Types
|
|||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (readZebraTransaction)
|
||||
import ZcashHaskell.Utils (f4Jumble, makeZebraCall, readZebraTransaction)
|
||||
import Zenith.Core
|
||||
import Zenith.DB
|
||||
import Zenith.Tree
|
||||
|
|
@ -211,384 +212,6 @@ main = do
|
|||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
|
||||
oNotes `shouldBe` []
|
||||
describe "Creating Tx" $ do
|
||||
describe "Full" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
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 3)
|
||||
3026170
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldBe` (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 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
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 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError "Receiver not capable of Full privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
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)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Combination of receivers not allowed for Full privacy")
|
||||
describe "Medium" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
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 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError "Receiver not capable of Medium privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
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)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "Low" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "None" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "Tree tests" $ do
|
||||
let cmx1 =
|
||||
hexString
|
||||
|
|
@ -636,3 +259,380 @@ main = do
|
|||
Just t1 -> do
|
||||
let t = root $ mkOrchardTree t1
|
||||
getTag (value t) `shouldBe` getOrchardTreeAnchor t1
|
||||
describe "Creating Tx" $ do
|
||||
describe "Full" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
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 3)
|
||||
3026170
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` 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 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
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 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left (PrivacyPolicyError "Receiver not capable of Full privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
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)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Combination of receivers not allowed for Full privacy")
|
||||
describe "Medium" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` 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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "00")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
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 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError "Receiver not capable of Medium privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
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)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "Low" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "None" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
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)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
Subproject commit b6d490d05300a9db9cdf9929baa9b984bee9f3f6
|
||||
Subproject commit f6b8a772770f492221dc99281016d7090f981e63
|
||||
|
|
@ -142,6 +142,7 @@ test-suite zenith-tests
|
|||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, bytestring
|
||||
, aeson
|
||||
, configurator
|
||||
, monad-logger
|
||||
, aeson
|
||||
|
|
|
|||
Loading…
Reference in a new issue