Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 21 Pull requests Projects Releases 6 Packages Wiki Activity

Merge branch 'rav001' into rvv001

Browse source 
- fix transaction fee calculation
This commit is contained in:
Rene V. Vergara A. 2024-10-30 15:16:03 -04:00
commit 117a4fa2ea
4 changed files with 729 additions and 774 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

729
src/Zenith/Core.hs
View file

@ -23,7 +23,7 @@ import Data.Aeson
import Data.Binary.Get hiding (getBytes) import Data.Binary.Get hiding (getBytes)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import Data.HexString (HexString, toBytes, toText) import Data.HexString (HexString, hexBytes, hexString, toBytes, toText)
import Data.Int (Int64) import Data.Int (Int64)
import Data.List import Data.List
import Data.Maybe (fromJust, fromMaybe) import Data.Maybe (fromJust, fromMaybe)
@ -522,265 +522,271 @@ updateOrchardWitnesses pool = do
-- | Calculate fee per ZIP-317 -- | Calculate fee per ZIP-317
calculateTxFee :: calculateTxFee ::
([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote]) ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
-> Int -> [OutgoingNote]
-> Integer -> Int64
calculateTxFee (t, s, o) i = calculateTxFee (t, s, o) nout =
fromIntegral fromIntegral $ 5000 * (tcount + saction + oaction)
(5000 * (max (length t) tout + max (length s) sout + length o + oout))
where where
tout = tout =
if i == 1 || i == 2 length $
then 1 filter
else 0 (\(OutgoingNote x _ _ _ _ _) -> x == 1 || x == 2 || x == 5 || x == 6)
sout = nout
if i == 3 sout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 3) nout
then 1 oout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 4) nout
else 0 tcount = max (length t) tout
oout = scount = max (length s) sout
if i == 4 ocount = max (length o) oout
then 1 saction =
else 0 if scount == 1
then 2
else scount
oaction =
if ocount == 1
then 2
else ocount
-- | Prepare a transaction for sending -- | Prepare a transaction for sending
prepareTx :: {-
ConnectionPool -prepareTx ::
-> T.Text - ConnectionPool
-> Int - -> T.Text
-> ZcashNet - -> Int
-> ZcashAccountId - -> ZcashNet
-> Int - -> ZcashAccountId
-> Scientific - -> Int
-> UnifiedAddress - -> Scientific
-> T.Text - -> UnifiedAddress
-> LoggingT IO (Either TxError HexString) - -> T.Text
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do - -> LoggingT IO (Either TxError HexString)
accRead <- liftIO $ getAccountById pool za -prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
let recipient = - accRead <- liftIO $ getAccountById pool za
case o_rec ua of - let recipient =
Nothing -> - case o_rec ua of
case s_rec ua of - Nothing ->
Nothing -> - case s_rec ua of
case t_rec ua of - Nothing ->
Nothing -> (0, "") - case t_rec ua of
Just r3 -> - Nothing -> (0, "")
case tr_type r3 of - Just r3 ->
P2PKH -> (1, toBytes $ tr_bytes r3) - case tr_type r3 of
P2SH -> (2, toBytes $ tr_bytes r3) - P2PKH -> (1, toBytes $ tr_bytes r3)
Just r2 -> (3, getBytes r2) - P2SH -> (2, toBytes $ tr_bytes r3)
Just r1 -> (4, getBytes r1) - Just r2 -> (3, getBytes r2)
logDebugN $ T.pack $ show recipient - Just r1 -> (4, getBytes r1)
logDebugN $ T.pack $ "Target block: " ++ show bh - logDebugN $ T.pack $ show recipient
trees <- - logDebugN $ T.pack $ "Target block: " ++ show bh
liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh - trees <-
let sT = SaplingCommitmentTree $ ztiSapling trees - liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
let oT = OrchardCommitmentTree $ ztiOrchard trees - let sT = SaplingCommitmentTree $ ztiSapling trees
case accRead of - let oT = OrchardCommitmentTree $ ztiOrchard trees
Nothing -> do - case accRead of
logErrorN "Can't find Account" - Nothing -> do
return $ Left ZHError - logErrorN "Can't find Account"
Just acc -> do - return $ Left ZHError
logDebugN $ T.pack $ show acc - Just acc -> do
let zats' = toBoundedInteger $ amt * scientific 1 8 - logDebugN $ T.pack $ show acc
case zats' of - let zats' = toBoundedInteger $ amt * scientific 1 8
Nothing -> return $ Left ZHError - case zats' of
Just zats -> do - Nothing -> return $ Left ZHError
logDebugN $ T.pack $ show (zats :: Int64) - Just zats -> do
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-} - logDebugN $ T.pack $ show (zats :: Int64)
--let fee = calculateTxFee firstPass $ fst recipient - {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
--logDebugN $ T.pack $ "calculated fee " ++ show fee - --let fee = calculateTxFee firstPass $ fst recipient
(tList, sList, oList) <- - --logDebugN $ T.pack $ "calculated fee " ++ show fee
liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000) - (tList, sList, oList) <-
logDebugN "selected notes" - liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
logDebugN $ T.pack $ show tList - logDebugN "selected notes"
logDebugN $ T.pack $ show sList - logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show oList - logDebugN $ T.pack $ show sList
let noteTotal = getTotalAmount (tList, sList, oList) - logDebugN $ T.pack $ show oList
tSpends <- - let noteTotal = getTotalAmount (tList, sList, oList)
liftIO $ - tSpends <-
prepTSpends - liftIO $
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc) - prepTSpends
tList - (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
--print tSpends - tList
sSpends <- - --print tSpends
liftIO $ - sSpends <-
prepSSpends - liftIO $
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc) - prepSSpends
sList - (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
--print sSpends - sList
oSpends <- - --print sSpends
liftIO $ - oSpends <-
prepOSpends - liftIO $
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) - prepOSpends
oList - (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
--print oSpends - oList
dummy <- - --print oSpends
liftIO $ - dummy <-
makeOutgoing - liftIO $
acc - makeOutgoing
recipient - acc
zats - recipient
(fromInteger noteTotal - 5000 - zats) - zats
logDebugN "Calculating fee" - (fromInteger noteTotal - 5000 - zats)
let feeResponse = - logDebugN "Calculating fee"
createTransaction - let feeResponse =
(Just sT) - createTransaction
(Just oT) - (Just sT)
tSpends - (Just oT)
sSpends - tSpends
oSpends - sSpends
dummy - oSpends
zn - dummy
bh - zn
False - bh
case feeResponse of - False
Left e1 -> return $ Left Fee - case feeResponse of
Right fee -> do - Left e1 -> return $ Left Fee
let feeAmt = - Right fee -> do
fromIntegral - let feeAmt =
(runGet getInt64le $ LBS.fromStrict $ toBytes fee) - fromIntegral
(tList1, sList1, oList1) <- - (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt) - (tList1, sList1, oList1) <-
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt - liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
logDebugN $ T.pack $ show tList - logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show sList - logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show oList - logDebugN $ T.pack $ show sList
outgoing <- - logDebugN $ T.pack $ show oList
liftIO $ - outgoing <-
makeOutgoing - liftIO $
acc - makeOutgoing
recipient - acc
zats - recipient
(fromInteger noteTotal - fromInteger feeAmt - zats) - zats
logDebugN $ T.pack $ show outgoing - (fromInteger noteTotal - fromInteger feeAmt - zats)
let tx = - logDebugN $ T.pack $ show outgoing
createTransaction - let tx =
(Just sT) - createTransaction
(Just oT) - (Just sT)
tSpends - (Just oT)
sSpends - tSpends
oSpends - sSpends
outgoing - oSpends
zn - outgoing
bh - zn
True - bh
logDebugN $ T.pack $ show tx - True
return tx - logDebugN $ T.pack $ show tx
where - return tx
makeOutgoing :: - where
Entity ZcashAccount - makeOutgoing ::
-> (Int, BS.ByteString) - Entity ZcashAccount
-> Int64 - -> (Int, BS.ByteString)
-> Int64 - -> Int64
-> IO [OutgoingNote] - -> Int64
makeOutgoing acc (k, recvr) zats chg = do - -> IO [OutgoingNote]
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc - makeOutgoing acc (k, recvr) zats chg = do
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr - chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
let chgRcvr = - let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) - let chgRcvr =
return - fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
[ OutgoingNote - return
4 - [ OutgoingNote
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) - 4
(getBytes chgRcvr) - (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(fromIntegral chg) - (getBytes chgRcvr)
"" - (fromIntegral chg)
True - ""
, OutgoingNote - True
(fromIntegral k) - , OutgoingNote
(case k of - (fromIntegral k)
4 -> - (case k of
getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc - 4 ->
3 -> - getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc - 3 ->
_ -> "") - getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
recvr - _ -> "")
(fromIntegral zats) - recvr
(E.encodeUtf8 memo) - (fromIntegral zats)
False - (E.encodeUtf8 memo)
] - False
getTotalAmount :: - ]
( [Entity WalletTrNote] - getTotalAmount ::
, [Entity WalletSapNote] - ( [Entity WalletTrNote]
, [Entity WalletOrchNote]) - , [Entity WalletSapNote]
-> Integer - , [Entity WalletOrchNote])
getTotalAmount (t, s, o) = - -> Integer
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) + - getTotalAmount (t, s, o) =
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) + - sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
sum (map (fromIntegral . walletOrchNoteValue . entityVal) o) - sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
prepTSpends :: - sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
TransparentSpendingKey - prepTSpends ::
-> [Entity WalletTrNote] - TransparentSpendingKey
-> IO [TransparentTxSpend] - -> [Entity WalletTrNote]
prepTSpends sk notes = do - -> IO [TransparentTxSpend]
forM notes $ \n -> do - prepTSpends sk notes = do
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n - forM notes $ \n -> do
case tAddRead of - tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
Nothing -> throwIO $ userError "Couldn't read t-address" - case tAddRead of
Just tAdd -> do - Nothing -> throwIO $ userError "Couldn't read t-address"
(XPrvKey _ _ _ _ (SecKey xp_key)) <- - Just tAdd -> do
genTransparentSecretKey - (XPrvKey _ _ _ _ (SecKey xp_key)) <-
(walletAddressIndex $ entityVal tAdd) - genTransparentSecretKey
(getScope $ walletAddressScope $ entityVal tAdd) - (walletAddressIndex $ entityVal tAdd)
sk - (getScope $ walletAddressScope $ entityVal tAdd)
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n - sk
case mReverseTxId of - mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
Nothing -> throwIO $ userError "failed to get tx ID" - case mReverseTxId of
Just (ESQ.Value reverseTxId) -> do - Nothing -> throwIO $ userError "failed to get tx ID"
let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId - Just (ESQ.Value reverseTxId) -> do
return $ - let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
TransparentTxSpend - return $
xp_key - TransparentTxSpend
(RawOutPoint - xp_key
flipTxId - (RawOutPoint
(fromIntegral $ walletTrNotePosition $ entityVal n)) - flipTxId
(RawTxOut - (fromIntegral $ walletTrNotePosition $ entityVal n))
(fromIntegral $ walletTrNoteValue $ entityVal n) - (RawTxOut
(walletTrNoteScript $ entityVal n)) - (fromIntegral $ walletTrNoteValue $ entityVal n)
prepSSpends :: - (walletTrNoteScript $ entityVal n))
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend] - prepSSpends ::
prepSSpends sk notes = do - SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
forM notes $ \n -> do - prepSSpends sk notes = do
return $ - forM notes $ \n -> do
SaplingTxSpend - return $
(getBytes sk) - SaplingTxSpend
(DecodedNote - (getBytes sk)
(fromIntegral $ walletSapNoteValue $ entityVal n) - (DecodedNote
(walletSapNoteRecipient $ entityVal n) - (fromIntegral $ walletSapNoteValue $ entityVal n)
(E.encodeUtf8 $ walletSapNoteMemo $ entityVal n) - (walletSapNoteRecipient $ entityVal n)
(getHex $ walletSapNoteNullifier $ entityVal n) - (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
"" - (getHex $ walletSapNoteNullifier $ entityVal n)
(getRseed $ walletSapNoteRseed $ entityVal n)) - ""
(toBytes $ getHex $ walletSapNoteWitness $ entityVal n) - (getRseed $ walletSapNoteRseed $ entityVal n))
prepOSpends :: - (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend] - prepOSpends ::
prepOSpends sk notes = do - OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
forM notes $ \n -> do - prepOSpends sk notes = do
return $ - forM notes $ \n -> do
OrchardTxSpend - return $
(getBytes sk) - OrchardTxSpend
(DecodedNote - (getBytes sk)
(fromIntegral $ walletOrchNoteValue $ entityVal n) - (DecodedNote
(walletOrchNoteRecipient $ entityVal n) - (fromIntegral $ walletOrchNoteValue $ entityVal n)
(E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n) - (walletOrchNoteRecipient $ entityVal n)
(getHex $ walletOrchNoteNullifier $ entityVal n) - (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
(walletOrchNoteRho $ entityVal n) - (getHex $ walletOrchNoteNullifier $ entityVal n)
(getRseed $ walletOrchNoteRseed $ entityVal n)) - (walletOrchNoteRho $ entityVal n)
(toBytes $ getHex $ walletOrchNoteWitness $ entityVal n) - (getRseed $ walletOrchNoteRseed $ entityVal n))
sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness - (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
sapAnchor notes = - sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
if not (null notes) - sapAnchor notes =
then Just $ - if not (null notes)
SaplingWitness $ - then Just $
getHex $ walletSapNoteWitness $ entityVal $ head notes - SaplingWitness $
else Nothing - getHex $ walletSapNoteWitness $ entityVal $ head notes
orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness - else Nothing
orchAnchor notes = - orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
if not (null notes) - orchAnchor notes =
then Just $ - if not (null notes)
OrchardWitness $ - then Just $
getHex $ walletOrchNoteWitness $ entityVal $ head notes - OrchardWitness $
else Nothing - getHex $ walletOrchNoteWitness $ entityVal $ head notes
- else Nothing
-}
deshieldNotes :: deshieldNotes ::
ConnectionPool ConnectionPool
-> T.Text -> T.Text
@ -843,48 +849,32 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
4 4
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes oRcvr) (getBytes oRcvr)
(fromIntegral $ noteTotal - 5000) (fromIntegral $ noteTotal - 500)
"" ""
True True
let feeResponse = let feeAmt = calculateTxFee (trNotes, [], []) [dummy]
createTransaction let snote =
Nothing OutgoingNote
Nothing 4
tSpends (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
[] (getBytes oRcvr)
[] (fromIntegral $ noteTotal - fromIntegral feeAmt)
[dummy] ""
znet True
bh tx <-
False liftIO $
case feeResponse of createTransaction
Left e1 -> return $ Left Fee Nothing
Right fee -> do Nothing
let feeAmt = tSpends
fromIntegral []
(runGet getInt64le $ LBS.fromStrict $ toBytes fee) []
let snote = [snote]
OutgoingNote znet
4 (bh + 3)
(getBytes $ True
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) logDebugN $ T.pack $ show tx
(getBytes oRcvr) return tx
(fromIntegral $ noteTotal - feeAmt)
""
True
let tx =
createTransaction
Nothing
Nothing
tSpends
[]
[]
[snote]
znet
(bh + 3)
True
logDebugN $ T.pack $ show tx
return tx
where where
getTotalAmount :: getTotalAmount ::
( [Entity WalletTrNote] ( [Entity WalletTrNote]
@ -941,11 +931,10 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
let recipients = map extractReceiver pnotes let recipients = map extractReceiver pnotes
logDebugN $ T.pack $ show recipients logDebugN $ T.pack $ show recipients
logDebugN $ T.pack $ "Target block: " ++ show bh logDebugN $ T.pack $ "Target block: " ++ show bh
{- trees <-
-trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
-let sT = SaplingCommitmentTree $ ztiSapling trees let sT = SaplingCommitmentTree $ ztiSapling trees
-let oT = OrchardCommitmentTree $ ztiOrchard trees let oT = OrchardCommitmentTree $ ztiOrchard trees
-}
case accRead of case accRead of
Nothing -> do Nothing -> do
logErrorN "Can't find Account" logErrorN "Can't find Account"
@ -969,7 +958,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
selectUnspentNotesV2 selectUnspentNotesV2
pool pool
za za
(zats + 10000) (zats + 20000)
(map (\(x, _, _, _) -> x) recipients) (map (\(x, _, _, _) -> x) recipients)
policy policy
case notePlan of case notePlan of
@ -998,94 +987,74 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
oList oList
--print oSpends --print oSpends
dummy' <- draft <-
liftIO $ liftIO $
makeOutgoing makeOutgoing
acc acc
recipients recipients
(noteTotal - 5000 - fromIntegral zats) (noteTotal - 5000 - fromIntegral zats)
policy policy
case dummy' of case draft of
Left e -> return $ Left e Left e -> return $ Left e
Right dummy -> do Right draftOut -> do
logDebugN "Calculating fee" let fee = calculateTxFee (tList, sList, oList) draftOut
let feeResponse = logDebugN $ T.pack $ "calculated fee " ++ show fee
createTransaction finalNotePlan <-
Nothing liftIO $
Nothing selectUnspentNotesV2
tSpends pool
sSpends za
oSpends (zats + fee)
dummy (map (\(x, _, _, _) -> x) recipients)
zn policy
bh case finalNotePlan of
False Right (tList1, sList1, oList1) -> do
case feeResponse of logDebugN $ T.pack $ "selected notes with fee" ++ show fee
Left e1 -> return $ Left Fee logDebugN $ T.pack $ show tList1
Right fee -> do logDebugN $ T.pack $ show sList1
let feeAmt = logDebugN $ T.pack $ show oList1
fromIntegral tSpends1 <-
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
finalNotePlan <-
liftIO $ liftIO $
selectUnspentNotesV2 prepTSpends
pool (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
za tList1
(fromIntegral zats + feeAmt) sSpends1 <-
(map (\(x, _, _, _) -> x) recipients) 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 policy
case finalNotePlan of logDebugN $ T.pack $ show outgoing'
Right (tList1, sList1, oList1) -> do case outgoing' of
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
Left e -> return $ Left e 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 Left e -> do
logErrorN $ T.pack $ show e logErrorN $ T.pack $ show e
return $ Left e return $ Left e

771
test/Spec.hs
View file

@ -37,7 +37,7 @@ import ZcashHaskell.Types
, ValidAddress(..) , ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
import ZcashHaskell.Utils (makeZebraCall, readZebraTransaction) import ZcashHaskell.Utils (f4Jumble, makeZebraCall, readZebraTransaction)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.Types import Zenith.Types
@ -204,395 +204,380 @@ main = do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1) oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
oNotes `shouldBe` [] oNotes `shouldBe` []
describe "Creating Tx" $ do describe "Creating Tx" $ do
describe "Full" $ do describe "Full" $ do
it "To Orchard" $ do it "To Orchard" $ do
let uaRead = let uaRead =
parseAddress parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
case uaRead of case uaRead of
Nothing -> assertFailure "wrong address" Nothing -> assertFailure "wrong address"
Just ua -> do Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <- tx <-
runFileLoggingT "zenith.log" $ runFileLoggingT "zenith.log" $
prepareTxV2 prepareTxV2
pool pool
"localhost" "localhost"
18232 18232
TestNet TestNet
(toSqlKey 3) (toSqlKey 3)
3026170 3026170
[ ProposedNote [ ProposedNote
(ValidAddressAPI $ fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
0.005 0.005
(Just "Sending memo to orchard") (Just "Sending memo to orchard")
] ]
Full Full
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldBe` (hexString "deadbeef") Right h -> h `shouldNotBe` hexString "deadbeef"
it "To Sapling" $ do it "To Sapling" $ do
let uaRead = let uaRead =
parseAddress parseAddress
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
case uaRead of case uaRead of
Nothing -> assertFailure "wrong address" Nothing -> assertFailure "wrong address"
Just ua -> do Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <- tx <-
runFileLoggingT "zenith.log" $ runFileLoggingT "zenith.log" $
prepareTxV2 prepareTxV2
pool pool
"localhost" "localhost"
18232 18232
TestNet TestNet
(toSqlKey 4) (toSqlKey 4)
3001331 3001331
[ ProposedNote [ ProposedNote
(ValidAddressAPI $ fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
0.005 0.005
(Just "Sending memo to sapling") (Just "Sending memo to sapling")
] ]
Full Full
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef") Right h -> h `shouldNotBe` hexString "deadbeef"
it "To Transparent" $ do it "To Transparent" $ do
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
case uaRead of case uaRead of
Nothing -> assertFailure "wrong address" Nothing -> assertFailure "wrong address"
Just ua -> do Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <- tx <-
runFileLoggingT "zenith.log" $ runFileLoggingT "zenith.log" $
prepareTxV2 prepareTxV2
pool pool
"localhost" "localhost"
18232 18232
TestNet TestNet
(toSqlKey 4) (toSqlKey 4)
3001331 3001331
[ ProposedNote [ ProposedNote
(ValidAddressAPI $ fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
0.005 0.005
Nothing Nothing
] ]
Full Full
tx `shouldBe` tx `shouldBe`
Left Left (PrivacyPolicyError "Receiver not capable of Full privacy")
(PrivacyPolicyError "Receiver not capable of Full privacy") it "To mixed shielded receivers" $ do
it "To mixed shielded receivers" $ do let uaRead =
let uaRead = parseAddress
parseAddress "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" let uaRead2 =
let uaRead2 = parseAddress
parseAddress "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" case uaRead of
case uaRead of Nothing -> assertFailure "wrong address"
Nothing -> assertFailure "wrong address" Just ua -> do
Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <-
tx <- runFileLoggingT "zenith.log" $
runFileLoggingT "zenith.log" $ prepareTxV2
prepareTxV2 pool
pool "localhost"
"localhost" 18232
18232 TestNet
TestNet (toSqlKey 1)
(toSqlKey 1) 3001331
3001331 [ ProposedNote
[ ProposedNote (ValidAddressAPI $ fromJust uaRead)
(ValidAddressAPI $ fromJust uaRead) 0.005
0.005 (Just "Sending memo to orchard")
(Just "Sending memo to orchard") , ProposedNote
, ProposedNote (ValidAddressAPI $ fromJust uaRead2)
(ValidAddressAPI $ fromJust uaRead2) 0.004
0.004 Nothing
Nothing ]
] Full
Full tx `shouldBe`
tx `shouldBe` Left
Left (PrivacyPolicyError
(PrivacyPolicyError "Combination of receivers not allowed for Full privacy")
"Combination of receivers not allowed for Full privacy") describe "Medium" $ do
describe "Medium" $ do it "To Orchard" $ do
it "To Orchard" $ do let uaRead =
let uaRead = parseAddress
parseAddress "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" case uaRead of
case uaRead of Nothing -> assertFailure "wrong address"
Nothing -> assertFailure "wrong address" Just ua -> do
Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <-
tx <- runFileLoggingT "zenith.log" $
runFileLoggingT "zenith.log" $ prepareTxV2
prepareTxV2 pool
pool "localhost"
"localhost" 18232
18232 TestNet
TestNet (toSqlKey 1)
(toSqlKey 1) 3001372
3001372 [ ProposedNote
[ ProposedNote (ValidAddressAPI $ fromJust uaRead)
(ValidAddressAPI $ fromJust uaRead) 0.005
0.005 (Just "Sending memo to orchard")
(Just "Sending memo to orchard") ]
] Medium
Medium case tx of
case tx of Left e -> assertFailure $ show e
Left e -> assertFailure $ show e Right h -> h `shouldNotBe` hexString "deadbeef"
Right h -> h `shouldNotBe` (hexString "deadbeef") it "To Sapling" $ do
it "To Sapling" $ do let uaRead =
let uaRead = parseAddress
parseAddress "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" case uaRead of
case uaRead of Nothing -> assertFailure "wrong address"
Nothing -> assertFailure "wrong address" Just ua -> do
Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <-
tx <- runFileLoggingT "zenith.log" $
runFileLoggingT "zenith.log" $ prepareTxV2
prepareTxV2 pool
pool "localhost"
"localhost" 18232
18232 TestNet
TestNet (toSqlKey 1)
(toSqlKey 1) 3001372
3001372 [ ProposedNote
[ ProposedNote (ValidAddressAPI $ fromJust uaRead)
(ValidAddressAPI $ fromJust uaRead) 0.005
0.005 (Just "Sending memo to sapling")
(Just "Sending memo to sapling") ]
] Medium
Medium case tx of
case tx of Left e -> assertFailure $ show e
Left e -> assertFailure $ show e Right h -> h `shouldNotBe` (hexString "00")
Right h -> h `shouldNotBe` (hexString "deadbeef") it "To Transparent" $ do
it "To Transparent" $ do let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" case uaRead of
case uaRead of Nothing -> assertFailure "wrong address"
Nothing -> assertFailure "wrong address" Just ua -> do
Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <-
tx <- runFileLoggingT "zenith.log" $
runFileLoggingT "zenith.log" $ prepareTxV2
prepareTxV2 pool
pool "localhost"
"localhost" 18232
18232 TestNet
TestNet (toSqlKey 4)
(toSqlKey 4) 3001331
3001331 [ ProposedNote
[ ProposedNote (ValidAddressAPI $ fromJust uaRead)
(ValidAddressAPI $ fromJust uaRead) 0.005
0.005 Nothing
Nothing ]
] Medium
Medium tx `shouldBe`
tx `shouldBe` Left
Left (PrivacyPolicyError "Receiver not capable of Medium privacy")
(PrivacyPolicyError "Receiver not capable of Medium privacy") it "To mixed shielded receivers" $ do
it "To mixed shielded receivers" $ do let uaRead =
let uaRead = parseAddress
parseAddress "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" let uaRead2 =
let uaRead2 = parseAddress
parseAddress "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" case uaRead of
case uaRead of Nothing -> assertFailure "wrong address"
Nothing -> assertFailure "wrong address" Just ua -> do
Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <-
tx <- runFileLoggingT "zenith.log" $
runFileLoggingT "zenith.log" $ prepareTxV2
prepareTxV2 pool
pool "localhost"
"localhost" 18232
18232 TestNet
TestNet (toSqlKey 1)
(toSqlKey 1) 3001331
3001331 [ ProposedNote
[ ProposedNote (ValidAddressAPI $ fromJust uaRead)
(ValidAddressAPI $ fromJust uaRead) 0.005
0.005 (Just "Sending memo to orchard")
(Just "Sending memo to orchard") , ProposedNote
, ProposedNote (ValidAddressAPI $ fromJust uaRead2)
(ValidAddressAPI $ fromJust uaRead2) 0.004
0.004 Nothing
Nothing ]
] Medium
Medium case tx of
case tx of Left e -> assertFailure $ show e
Left e -> assertFailure $ show e Right h -> h `shouldNotBe` (hexString "deadbeef")
Right h -> h `shouldNotBe` (hexString "deadbeef") describe "Low" $ do
describe "Low" $ do it "To Orchard" $ do
it "To Orchard" $ do let uaRead =
let uaRead = parseAddress
parseAddress "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" case uaRead of
case uaRead of Nothing -> assertFailure "wrong address"
Nothing -> assertFailure "wrong address" Just ua -> do
Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <-
tx <- runFileLoggingT "zenith.log" $
runFileLoggingT "zenith.log" $ prepareTxV2
prepareTxV2 pool
pool "localhost"
"localhost" 18232
18232 TestNet
TestNet (toSqlKey 1)
(toSqlKey 1) 3001372
3001372 [ ProposedNote
[ ProposedNote (ValidAddressAPI $ fromJust uaRead)
(ValidAddressAPI $ fromJust uaRead) 0.005
0.005 Nothing
Nothing ]
] Low
Low case tx of
case tx of Left e -> assertFailure $ show e
Left e -> assertFailure $ show e Right h -> h `shouldNotBe` (hexString "deadbeef")
Right h -> h `shouldNotBe` (hexString "deadbeef") it "To Sapling" $ do
it "To Sapling" $ do let uaRead =
let uaRead = parseAddress
parseAddress "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" case uaRead of
case uaRead of Nothing -> assertFailure "wrong address"
Nothing -> assertFailure "wrong address" Just ua -> do
Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <-
tx <- runFileLoggingT "zenith.log" $
runFileLoggingT "zenith.log" $ prepareTxV2
prepareTxV2 pool
pool "localhost"
"localhost" 18232
18232 TestNet
TestNet (toSqlKey 1)
(toSqlKey 1) 3001372
3001372 [ ProposedNote
[ ProposedNote (ValidAddressAPI $ fromJust uaRead)
(ValidAddressAPI $ fromJust uaRead) 0.005
0.005 Nothing
Nothing ]
] Low
Low case tx of
case tx of Left e -> assertFailure $ show e
Left e -> assertFailure $ show e Right h -> h `shouldNotBe` (hexString "deadbeef")
Right h -> h `shouldNotBe` (hexString "deadbeef") it "To Transparent" $ do
it "To Transparent" $ do let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" case uaRead of
case uaRead of Nothing -> assertFailure "wrong address"
Nothing -> assertFailure "wrong address" Just ua -> do
Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <-
tx <- runFileLoggingT "zenith.log" $
runFileLoggingT "zenith.log" $ prepareTxV2
prepareTxV2 pool
pool "localhost"
"localhost" 18232
18232 TestNet
TestNet (toSqlKey 1)
(toSqlKey 1) 3001372
3001372 [ ProposedNote
[ ProposedNote (ValidAddressAPI $ fromJust uaRead)
(ValidAddressAPI $ fromJust uaRead) 0.005
0.005 Nothing
Nothing ]
] Low
Low case tx of
case tx of Left e -> assertFailure $ show e
Left e -> assertFailure $ show e Right h -> h `shouldNotBe` (hexString "deadbeef")
Right h -> h `shouldNotBe` (hexString "deadbeef") describe "None" $ do
describe "None" $ do it "To Orchard" $ do
it "To Orchard" $ do let uaRead =
let uaRead = parseAddress
parseAddress "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" case uaRead of
case uaRead of Nothing -> assertFailure "wrong address"
Nothing -> assertFailure "wrong address" Just ua -> do
Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <-
tx <- runFileLoggingT "zenith.log" $
runFileLoggingT "zenith.log" $ prepareTxV2
prepareTxV2 pool
pool "localhost"
"localhost" 18232
18232 TestNet
TestNet (toSqlKey 1)
(toSqlKey 1) 3001372
3001372 [ ProposedNote
[ ProposedNote (ValidAddressAPI $ fromJust uaRead)
(ValidAddressAPI $ fromJust uaRead) 0.005
0.005 Nothing
Nothing ]
] None
None tx `shouldBe`
tx `shouldBe` Left
Left (PrivacyPolicyError
(PrivacyPolicyError "Shielded recipients not compatible with privacy policy.")
"Shielded recipients not compatible with privacy policy.") it "To Sapling" $ do
it "To Sapling" $ do let uaRead =
let uaRead = parseAddress
parseAddress "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" case uaRead of
case uaRead of Nothing -> assertFailure "wrong address"
Nothing -> assertFailure "wrong address" Just ua -> do
Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <-
tx <- runFileLoggingT "zenith.log" $
runFileLoggingT "zenith.log" $ prepareTxV2
prepareTxV2 pool
pool "localhost"
"localhost" 18232
18232 TestNet
TestNet (toSqlKey 1)
(toSqlKey 1) 3001372
3001372 [ ProposedNote
[ ProposedNote (ValidAddressAPI $ fromJust uaRead)
(ValidAddressAPI $ fromJust uaRead) 0.005
0.005 Nothing
Nothing ]
] None
None tx `shouldBe`
tx `shouldBe` Left
Left (PrivacyPolicyError
(PrivacyPolicyError "Shielded recipients not compatible with privacy policy.")
"Shielded recipients not compatible with privacy policy.") it "To Transparent" $ do
it "To Transparent" $ do let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" case uaRead of
case uaRead of Nothing -> assertFailure "wrong address"
Nothing -> assertFailure "wrong address" Just ua -> do
Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <-
tx <- runFileLoggingT "zenith.log" $
runFileLoggingT "zenith.log" $ prepareTxV2
prepareTxV2 pool
pool "localhost"
"localhost" 18232
18232 TestNet
TestNet (toSqlKey 1)
(toSqlKey 1) 3001372
3001372 [ ProposedNote
[ ProposedNote (ValidAddressAPI $ fromJust uaRead)
(ValidAddressAPI $ fromJust uaRead) 0.005
0.005 Nothing
Nothing ]
] None
None case tx of
case tx of Left e -> assertFailure $ show e
Left e -> assertFailure $ show e Right h -> h `shouldNotBe` hexString "deadbeef"
Right h -> h `shouldNotBe` (hexString "deadbeef")
describe "Quick tests" $ do
it "validate comm trees" $ do
blockTree <- getCommitmentTrees "localhost" 18232 3034848
hashTree <-
makeZebraCall
"localhost"
18232
"z_gettreestate"
[ Data.Aeson.String
"000f8a912c6c5caf476e70fa0616c17ab4e7e8c1f42e24bddeacda275d545473"
]
case hashTree of
Left e -> assertFailure e
Right hT -> blockTree `shouldBe` hT

2
zcash-haskell

@ -1 +1 @@
Subproject commit 662a0d1148d3f52e2683157a4c9280bb8e81b0cb Subproject commit 6d4b6840d30fe1631902acd0388bef0040fee9e8

1
zenith.cabal
View file

@ -141,6 +141,7 @@ test-suite zenith-tests
build-depends: build-depends:
base >=4.12 && <5 base >=4.12 && <5
, bytestring , bytestring
, aeson
, configurator , configurator
, monad-logger , monad-logger
, data-default , data-default