feat(core): use new createTransaction function
This commit is contained in:
parent
723d1b4e1c
commit
78437987bf
GPG key ID:
65122AD495A7F5B2
4 changed files with 729 additions and 774 deletions
|
|
@ -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
771
test/Spec.hs
|
|
@ -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
|
|
||||||
|
|
|
||||||
|
|
@ -1 +1 @@
|
||||||
Subproject commit 662a0d1148d3f52e2683157a4c9280bb8e81b0cb
|
Subproject commit 6d4b6840d30fe1631902acd0388bef0040fee9e8
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue