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

Milestone 3: RPC server, ZIP-320 #104

Merged
pitmutt merged 152 commits from milestone3 into master 2024-11-21 15:39:19 +00:00
Conversation 0 Commits 152 Files changed 22 +729 -774
4 changed files with 729 additions and 774 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files
Showing only changes of commit 78437987bf - Show all commits

609
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,36 +849,20 @@ 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
Nothing
Nothing
tSpends
[]
[]
[dummy]
znet
bh
False
case feeResponse of
Left e1 -> return $ Left Fee
Right fee -> do
let feeAmt =
fromIntegral
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
let snote = let snote =
OutgoingNote OutgoingNote
4 4
(getBytes $ (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes oRcvr) (getBytes oRcvr)
(fromIntegral $ noteTotal - feeAmt) (fromIntegral $ noteTotal - fromIntegral feeAmt)
"" ""
True True
let tx = tx <-
liftIO $
createTransaction createTransaction
Nothing Nothing
Nothing Nothing
@ -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,84 +987,64 @@ 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
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 <- finalNotePlan <-
liftIO $ liftIO $
selectUnspentNotesV2 selectUnspentNotesV2
pool pool
za za
(fromIntegral zats + feeAmt) (zats + fee)
(map (\(x, _, _, _) -> x) recipients) (map (\(x, _, _, _) -> x) recipients)
policy policy
case finalNotePlan of case finalNotePlan of
Right (tList1, sList1, oList1) -> do Right (tList1, sList1, oList1) -> do
logDebugN $ logDebugN $ T.pack $ "selected notes with fee" ++ show fee
T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList1 logDebugN $ T.pack $ show tList1
logDebugN $ T.pack $ show sList1 logDebugN $ T.pack $ show sList1
logDebugN $ T.pack $ show oList1 logDebugN $ T.pack $ show oList1
tSpends1 <- tSpends1 <-
liftIO $ liftIO $
prepTSpends prepTSpends
(getTranSK $ (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
zcashAccountTPrivateKey $ entityVal acc)
tList1 tList1
sSpends1 <- sSpends1 <-
liftIO $ liftIO $
prepSSpends prepSSpends
(getSapSK $ (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
zcashAccountSapSpendKey $ entityVal acc)
sList1 sList1
oSpends1 <- oSpends1 <-
liftIO $ liftIO $
prepOSpends prepOSpends
(getOrchSK $ (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
zcashAccountOrchSpendKey $ entityVal acc)
oList1 oList1
let noteTotal1 = let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
getTotalAmount (tList1, sList1, oList1)
outgoing' <- outgoing' <-
liftIO $ liftIO $
makeOutgoing makeOutgoing
acc acc
recipients recipients
(noteTotal1 - feeAmt - fromIntegral zats) (noteTotal1 - fee - fromIntegral zats)
policy policy
logDebugN $ T.pack $ show outgoing' logDebugN $ T.pack $ show outgoing'
case outgoing' of case outgoing' of
Left e -> return $ Left e Left e -> return $ Left e
Right outgoing -> do Right outgoing -> do
let tx = tx <-
liftIO $
createTransaction createTransaction
Nothing (Just sT)
Nothing (Just oT)
tSpends1 tSpends1
sSpends1 sSpends1
oSpends1 oSpends1

29
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
@ -231,7 +231,7 @@ main = do
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
@ -257,7 +257,7 @@ main = do
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
@ -280,8 +280,7 @@ main = do
] ]
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
@ -342,7 +341,7 @@ main = do
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
@ -368,7 +367,7 @@ main = do
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 "00")
it "To Transparent" $ do it "To Transparent" $ do
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
case uaRead of case uaRead of
@ -581,18 +580,4 @@ main = do
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