RPC Server #103
4 changed files with 729 additions and 774 deletions
|
|
@ -23,7 +23,7 @@ import Data.Aeson
|
|||
import Data.Binary.Get hiding (getBytes)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.HexString (HexString, toBytes, toText)
|
||||
import Data.HexString (HexString, hexBytes, hexString, toBytes, toText)
|
||||
import Data.Int (Int64)
|
||||
import Data.List
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
|
|
@ -522,265 +522,271 @@ updateOrchardWitnesses pool = do
|
|||
-- | Calculate fee per ZIP-317
|
||||
calculateTxFee ::
|
||||
([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
|
||||
-> Int
|
||||
-> Integer
|
||||
calculateTxFee (t, s, o) i =
|
||||
fromIntegral
|
||||
(5000 * (max (length t) tout + max (length s) sout + length o + oout))
|
||||
-> [OutgoingNote]
|
||||
-> Int64
|
||||
calculateTxFee (t, s, o) nout =
|
||||
fromIntegral $ 5000 * (tcount + saction + oaction)
|
||||
where
|
||||
tout =
|
||||
if i == 1 || i == 2
|
||||
then 1
|
||||
else 0
|
||||
sout =
|
||||
if i == 3
|
||||
then 1
|
||||
else 0
|
||||
oout =
|
||||
if i == 4
|
||||
then 1
|
||||
else 0
|
||||
length $
|
||||
filter
|
||||
(\(OutgoingNote x _ _ _ _ _) -> x == 1 || x == 2 || x == 5 || x == 6)
|
||||
nout
|
||||
sout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 3) nout
|
||||
oout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 4) nout
|
||||
tcount = max (length t) tout
|
||||
scount = max (length s) sout
|
||||
ocount = max (length o) oout
|
||||
saction =
|
||||
if scount == 1
|
||||
then 2
|
||||
else scount
|
||||
oaction =
|
||||
if ocount == 1
|
||||
then 2
|
||||
else ocount
|
||||
|
||||
-- | Prepare a transaction for sending
|
||||
prepareTx ::
|
||||
ConnectionPool
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Scientific
|
||||
-> UnifiedAddress
|
||||
-> T.Text
|
||||
-> LoggingT IO (Either TxError HexString)
|
||||
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
||||
accRead <- liftIO $ getAccountById pool za
|
||||
let recipient =
|
||||
case o_rec ua of
|
||||
Nothing ->
|
||||
case s_rec ua of
|
||||
Nothing ->
|
||||
case t_rec ua of
|
||||
Nothing -> (0, "")
|
||||
Just r3 ->
|
||||
case tr_type r3 of
|
||||
P2PKH -> (1, toBytes $ tr_bytes r3)
|
||||
P2SH -> (2, toBytes $ tr_bytes r3)
|
||||
Just r2 -> (3, getBytes r2)
|
||||
Just r1 -> (4, getBytes r1)
|
||||
logDebugN $ T.pack $ show recipient
|
||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
trees <-
|
||||
liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
case accRead of
|
||||
Nothing -> do
|
||||
logErrorN "Can't find Account"
|
||||
return $ Left ZHError
|
||||
Just acc -> do
|
||||
logDebugN $ T.pack $ show acc
|
||||
let zats' = toBoundedInteger $ amt * scientific 1 8
|
||||
case zats' of
|
||||
Nothing -> return $ Left ZHError
|
||||
Just zats -> do
|
||||
logDebugN $ T.pack $ show (zats :: Int64)
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--let fee = calculateTxFee firstPass $ fst recipient
|
||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
(tList, sList, oList) <-
|
||||
liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
|
||||
logDebugN "selected notes"
|
||||
logDebugN $ T.pack $ show tList
|
||||
logDebugN $ T.pack $ show sList
|
||||
logDebugN $ T.pack $ show oList
|
||||
let noteTotal = getTotalAmount (tList, sList, oList)
|
||||
tSpends <-
|
||||
liftIO $
|
||||
prepTSpends
|
||||
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
||||
tList
|
||||
--print tSpends
|
||||
sSpends <-
|
||||
liftIO $
|
||||
prepSSpends
|
||||
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||
sList
|
||||
--print sSpends
|
||||
oSpends <-
|
||||
liftIO $
|
||||
prepOSpends
|
||||
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
oList
|
||||
--print oSpends
|
||||
dummy <-
|
||||
liftIO $
|
||||
makeOutgoing
|
||||
acc
|
||||
recipient
|
||||
zats
|
||||
(fromInteger noteTotal - 5000 - zats)
|
||||
logDebugN "Calculating fee"
|
||||
let feeResponse =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
dummy
|
||||
zn
|
||||
bh
|
||||
False
|
||||
case feeResponse of
|
||||
Left e1 -> return $ Left Fee
|
||||
Right fee -> do
|
||||
let feeAmt =
|
||||
fromIntegral
|
||||
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||
(tList1, sList1, oList1) <-
|
||||
liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
|
||||
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
|
||||
logDebugN $ T.pack $ show tList
|
||||
logDebugN $ T.pack $ show sList
|
||||
logDebugN $ T.pack $ show oList
|
||||
outgoing <-
|
||||
liftIO $
|
||||
makeOutgoing
|
||||
acc
|
||||
recipient
|
||||
zats
|
||||
(fromInteger noteTotal - fromInteger feeAmt - zats)
|
||||
logDebugN $ T.pack $ show outgoing
|
||||
let tx =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
outgoing
|
||||
zn
|
||||
bh
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
where
|
||||
makeOutgoing ::
|
||||
Entity ZcashAccount
|
||||
-> (Int, BS.ByteString)
|
||||
-> Int64
|
||||
-> Int64
|
||||
-> IO [OutgoingNote]
|
||||
makeOutgoing acc (k, recvr) zats chg = do
|
||||
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||
let chgRcvr =
|
||||
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
return
|
||||
[ OutgoingNote
|
||||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
, OutgoingNote
|
||||
(fromIntegral k)
|
||||
(case k of
|
||||
4 ->
|
||||
getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
|
||||
3 ->
|
||||
getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
|
||||
_ -> "")
|
||||
recvr
|
||||
(fromIntegral zats)
|
||||
(E.encodeUtf8 memo)
|
||||
False
|
||||
]
|
||||
getTotalAmount ::
|
||||
( [Entity WalletTrNote]
|
||||
, [Entity WalletSapNote]
|
||||
, [Entity WalletOrchNote])
|
||||
-> Integer
|
||||
getTotalAmount (t, s, o) =
|
||||
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
|
||||
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
|
||||
sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
|
||||
prepTSpends ::
|
||||
TransparentSpendingKey
|
||||
-> [Entity WalletTrNote]
|
||||
-> IO [TransparentTxSpend]
|
||||
prepTSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
|
||||
case tAddRead of
|
||||
Nothing -> throwIO $ userError "Couldn't read t-address"
|
||||
Just tAdd -> do
|
||||
(XPrvKey _ _ _ _ (SecKey xp_key)) <-
|
||||
genTransparentSecretKey
|
||||
(walletAddressIndex $ entityVal tAdd)
|
||||
(getScope $ walletAddressScope $ entityVal tAdd)
|
||||
sk
|
||||
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
|
||||
case mReverseTxId of
|
||||
Nothing -> throwIO $ userError "failed to get tx ID"
|
||||
Just (ESQ.Value reverseTxId) -> do
|
||||
let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
|
||||
return $
|
||||
TransparentTxSpend
|
||||
xp_key
|
||||
(RawOutPoint
|
||||
flipTxId
|
||||
(fromIntegral $ walletTrNotePosition $ entityVal n))
|
||||
(RawTxOut
|
||||
(fromIntegral $ walletTrNoteValue $ entityVal n)
|
||||
(walletTrNoteScript $ entityVal n))
|
||||
prepSSpends ::
|
||||
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
|
||||
prepSSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
return $
|
||||
SaplingTxSpend
|
||||
(getBytes sk)
|
||||
(DecodedNote
|
||||
(fromIntegral $ walletSapNoteValue $ entityVal n)
|
||||
(walletSapNoteRecipient $ entityVal n)
|
||||
(E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
|
||||
(getHex $ walletSapNoteNullifier $ entityVal n)
|
||||
""
|
||||
(getRseed $ walletSapNoteRseed $ entityVal n))
|
||||
(toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
|
||||
prepOSpends ::
|
||||
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
|
||||
prepOSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
return $
|
||||
OrchardTxSpend
|
||||
(getBytes sk)
|
||||
(DecodedNote
|
||||
(fromIntegral $ walletOrchNoteValue $ entityVal n)
|
||||
(walletOrchNoteRecipient $ entityVal n)
|
||||
(E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
|
||||
(getHex $ walletOrchNoteNullifier $ entityVal n)
|
||||
(walletOrchNoteRho $ entityVal n)
|
||||
(getRseed $ walletOrchNoteRseed $ entityVal n))
|
||||
(toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
|
||||
sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
|
||||
sapAnchor notes =
|
||||
if not (null notes)
|
||||
then Just $
|
||||
SaplingWitness $
|
||||
getHex $ walletSapNoteWitness $ entityVal $ head notes
|
||||
else Nothing
|
||||
orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
|
||||
orchAnchor notes =
|
||||
if not (null notes)
|
||||
then Just $
|
||||
OrchardWitness $
|
||||
getHex $ walletOrchNoteWitness $ entityVal $ head notes
|
||||
else Nothing
|
||||
|
||||
{-
|
||||
-prepareTx ::
|
||||
- ConnectionPool
|
||||
- -> T.Text
|
||||
- -> Int
|
||||
- -> ZcashNet
|
||||
- -> ZcashAccountId
|
||||
- -> Int
|
||||
- -> Scientific
|
||||
- -> UnifiedAddress
|
||||
- -> T.Text
|
||||
- -> LoggingT IO (Either TxError HexString)
|
||||
-prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
||||
- accRead <- liftIO $ getAccountById pool za
|
||||
- let recipient =
|
||||
- case o_rec ua of
|
||||
- Nothing ->
|
||||
- case s_rec ua of
|
||||
- Nothing ->
|
||||
- case t_rec ua of
|
||||
- Nothing -> (0, "")
|
||||
- Just r3 ->
|
||||
- case tr_type r3 of
|
||||
- P2PKH -> (1, toBytes $ tr_bytes r3)
|
||||
- P2SH -> (2, toBytes $ tr_bytes r3)
|
||||
- Just r2 -> (3, getBytes r2)
|
||||
- Just r1 -> (4, getBytes r1)
|
||||
- logDebugN $ T.pack $ show recipient
|
||||
- logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
- trees <-
|
||||
- liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
|
||||
- let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
- let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
- case accRead of
|
||||
- Nothing -> do
|
||||
- logErrorN "Can't find Account"
|
||||
- return $ Left ZHError
|
||||
- Just acc -> do
|
||||
- logDebugN $ T.pack $ show acc
|
||||
- let zats' = toBoundedInteger $ amt * scientific 1 8
|
||||
- case zats' of
|
||||
- Nothing -> return $ Left ZHError
|
||||
- Just zats -> do
|
||||
- logDebugN $ T.pack $ show (zats :: Int64)
|
||||
- {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
- --let fee = calculateTxFee firstPass $ fst recipient
|
||||
- --logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
- (tList, sList, oList) <-
|
||||
- liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
|
||||
- logDebugN "selected notes"
|
||||
- logDebugN $ T.pack $ show tList
|
||||
- logDebugN $ T.pack $ show sList
|
||||
- logDebugN $ T.pack $ show oList
|
||||
- let noteTotal = getTotalAmount (tList, sList, oList)
|
||||
- tSpends <-
|
||||
- liftIO $
|
||||
- prepTSpends
|
||||
- (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
||||
- tList
|
||||
- --print tSpends
|
||||
- sSpends <-
|
||||
- liftIO $
|
||||
- prepSSpends
|
||||
- (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||
- sList
|
||||
- --print sSpends
|
||||
- oSpends <-
|
||||
- liftIO $
|
||||
- prepOSpends
|
||||
- (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
- oList
|
||||
- --print oSpends
|
||||
- dummy <-
|
||||
- liftIO $
|
||||
- makeOutgoing
|
||||
- acc
|
||||
- recipient
|
||||
- zats
|
||||
- (fromInteger noteTotal - 5000 - zats)
|
||||
- logDebugN "Calculating fee"
|
||||
- let feeResponse =
|
||||
- createTransaction
|
||||
- (Just sT)
|
||||
- (Just oT)
|
||||
- tSpends
|
||||
- sSpends
|
||||
- oSpends
|
||||
- dummy
|
||||
- zn
|
||||
- bh
|
||||
- False
|
||||
- case feeResponse of
|
||||
- Left e1 -> return $ Left Fee
|
||||
- Right fee -> do
|
||||
- let feeAmt =
|
||||
- fromIntegral
|
||||
- (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||
- (tList1, sList1, oList1) <-
|
||||
- liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
|
||||
- logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
|
||||
- logDebugN $ T.pack $ show tList
|
||||
- logDebugN $ T.pack $ show sList
|
||||
- logDebugN $ T.pack $ show oList
|
||||
- outgoing <-
|
||||
- liftIO $
|
||||
- makeOutgoing
|
||||
- acc
|
||||
- recipient
|
||||
- zats
|
||||
- (fromInteger noteTotal - fromInteger feeAmt - zats)
|
||||
- logDebugN $ T.pack $ show outgoing
|
||||
- let tx =
|
||||
- createTransaction
|
||||
- (Just sT)
|
||||
- (Just oT)
|
||||
- tSpends
|
||||
- sSpends
|
||||
- oSpends
|
||||
- outgoing
|
||||
- zn
|
||||
- bh
|
||||
- True
|
||||
- logDebugN $ T.pack $ show tx
|
||||
- return tx
|
||||
- where
|
||||
- makeOutgoing ::
|
||||
- Entity ZcashAccount
|
||||
- -> (Int, BS.ByteString)
|
||||
- -> Int64
|
||||
- -> Int64
|
||||
- -> IO [OutgoingNote]
|
||||
- makeOutgoing acc (k, recvr) zats chg = do
|
||||
- chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||
- let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||
- let chgRcvr =
|
||||
- fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
- return
|
||||
- [ OutgoingNote
|
||||
- 4
|
||||
- (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
- (getBytes chgRcvr)
|
||||
- (fromIntegral chg)
|
||||
- ""
|
||||
- True
|
||||
- , OutgoingNote
|
||||
- (fromIntegral k)
|
||||
- (case k of
|
||||
- 4 ->
|
||||
- getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
|
||||
- 3 ->
|
||||
- getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
|
||||
- _ -> "")
|
||||
- recvr
|
||||
- (fromIntegral zats)
|
||||
- (E.encodeUtf8 memo)
|
||||
- False
|
||||
- ]
|
||||
- getTotalAmount ::
|
||||
- ( [Entity WalletTrNote]
|
||||
- , [Entity WalletSapNote]
|
||||
- , [Entity WalletOrchNote])
|
||||
- -> Integer
|
||||
- getTotalAmount (t, s, o) =
|
||||
- sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
|
||||
- sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
|
||||
- sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
|
||||
- prepTSpends ::
|
||||
- TransparentSpendingKey
|
||||
- -> [Entity WalletTrNote]
|
||||
- -> IO [TransparentTxSpend]
|
||||
- prepTSpends sk notes = do
|
||||
- forM notes $ \n -> do
|
||||
- tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
|
||||
- case tAddRead of
|
||||
- Nothing -> throwIO $ userError "Couldn't read t-address"
|
||||
- Just tAdd -> do
|
||||
- (XPrvKey _ _ _ _ (SecKey xp_key)) <-
|
||||
- genTransparentSecretKey
|
||||
- (walletAddressIndex $ entityVal tAdd)
|
||||
- (getScope $ walletAddressScope $ entityVal tAdd)
|
||||
- sk
|
||||
- mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
|
||||
- case mReverseTxId of
|
||||
- Nothing -> throwIO $ userError "failed to get tx ID"
|
||||
- Just (ESQ.Value reverseTxId) -> do
|
||||
- let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
|
||||
- return $
|
||||
- TransparentTxSpend
|
||||
- xp_key
|
||||
- (RawOutPoint
|
||||
- flipTxId
|
||||
- (fromIntegral $ walletTrNotePosition $ entityVal n))
|
||||
- (RawTxOut
|
||||
- (fromIntegral $ walletTrNoteValue $ entityVal n)
|
||||
- (walletTrNoteScript $ entityVal n))
|
||||
- prepSSpends ::
|
||||
- SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
|
||||
- prepSSpends sk notes = do
|
||||
- forM notes $ \n -> do
|
||||
- return $
|
||||
- SaplingTxSpend
|
||||
- (getBytes sk)
|
||||
- (DecodedNote
|
||||
- (fromIntegral $ walletSapNoteValue $ entityVal n)
|
||||
- (walletSapNoteRecipient $ entityVal n)
|
||||
- (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
|
||||
- (getHex $ walletSapNoteNullifier $ entityVal n)
|
||||
- ""
|
||||
- (getRseed $ walletSapNoteRseed $ entityVal n))
|
||||
- (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
|
||||
- prepOSpends ::
|
||||
- OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
|
||||
- prepOSpends sk notes = do
|
||||
- forM notes $ \n -> do
|
||||
- return $
|
||||
- OrchardTxSpend
|
||||
- (getBytes sk)
|
||||
- (DecodedNote
|
||||
- (fromIntegral $ walletOrchNoteValue $ entityVal n)
|
||||
- (walletOrchNoteRecipient $ entityVal n)
|
||||
- (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
|
||||
- (getHex $ walletOrchNoteNullifier $ entityVal n)
|
||||
- (walletOrchNoteRho $ entityVal n)
|
||||
- (getRseed $ walletOrchNoteRseed $ entityVal n))
|
||||
- (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
|
||||
- sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
|
||||
- sapAnchor notes =
|
||||
- if not (null notes)
|
||||
- then Just $
|
||||
- SaplingWitness $
|
||||
- getHex $ walletSapNoteWitness $ entityVal $ head notes
|
||||
- else Nothing
|
||||
- orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
|
||||
- orchAnchor notes =
|
||||
- if not (null notes)
|
||||
- then Just $
|
||||
- OrchardWitness $
|
||||
- getHex $ walletOrchNoteWitness $ entityVal $ head notes
|
||||
- else Nothing
|
||||
-}
|
||||
deshieldNotes ::
|
||||
ConnectionPool
|
||||
-> T.Text
|
||||
|
|
@ -843,48 +849,32 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
|||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes oRcvr)
|
||||
(fromIntegral $ noteTotal - 5000)
|
||||
(fromIntegral $ noteTotal - 500)
|
||||
""
|
||||
True
|
||||
let feeResponse =
|
||||
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 =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $
|
||||
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes oRcvr)
|
||||
(fromIntegral $ noteTotal - feeAmt)
|
||||
""
|
||||
True
|
||||
let tx =
|
||||
createTransaction
|
||||
Nothing
|
||||
Nothing
|
||||
tSpends
|
||||
[]
|
||||
[]
|
||||
[snote]
|
||||
znet
|
||||
(bh + 3)
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
let feeAmt = calculateTxFee (trNotes, [], []) [dummy]
|
||||
let snote =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes oRcvr)
|
||||
(fromIntegral $ noteTotal - fromIntegral feeAmt)
|
||||
""
|
||||
True
|
||||
tx <-
|
||||
liftIO $
|
||||
createTransaction
|
||||
Nothing
|
||||
Nothing
|
||||
tSpends
|
||||
[]
|
||||
[]
|
||||
[snote]
|
||||
znet
|
||||
(bh + 3)
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
where
|
||||
getTotalAmount ::
|
||||
( [Entity WalletTrNote]
|
||||
|
|
@ -941,11 +931,10 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
let recipients = map extractReceiver pnotes
|
||||
logDebugN $ T.pack $ show recipients
|
||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
{-
|
||||
-trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
|
||||
-let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
-let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
-}
|
||||
trees <-
|
||||
liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
case accRead of
|
||||
Nothing -> do
|
||||
logErrorN "Can't find Account"
|
||||
|
|
@ -969,7 +958,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(zats + 10000)
|
||||
(zats + 20000)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
policy
|
||||
case notePlan of
|
||||
|
|
@ -998,94 +987,74 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
oList
|
||||
--print oSpends
|
||||
dummy' <-
|
||||
draft <-
|
||||
liftIO $
|
||||
makeOutgoing
|
||||
acc
|
||||
recipients
|
||||
(noteTotal - 5000 - fromIntegral zats)
|
||||
policy
|
||||
case dummy' of
|
||||
case draft of
|
||||
Left e -> return $ Left e
|
||||
Right dummy -> do
|
||||
logDebugN "Calculating fee"
|
||||
let feeResponse =
|
||||
createTransaction
|
||||
Nothing
|
||||
Nothing
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
dummy
|
||||
zn
|
||||
bh
|
||||
False
|
||||
case feeResponse of
|
||||
Left e1 -> return $ Left Fee
|
||||
Right fee -> do
|
||||
let feeAmt =
|
||||
fromIntegral
|
||||
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||
finalNotePlan <-
|
||||
Right draftOut -> do
|
||||
let fee = calculateTxFee (tList, sList, oList) draftOut
|
||||
logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
finalNotePlan <-
|
||||
liftIO $
|
||||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(zats + fee)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
policy
|
||||
case finalNotePlan of
|
||||
Right (tList1, sList1, oList1) -> do
|
||||
logDebugN $ T.pack $ "selected notes with fee" ++ show fee
|
||||
logDebugN $ T.pack $ show tList1
|
||||
logDebugN $ T.pack $ show sList1
|
||||
logDebugN $ T.pack $ show oList1
|
||||
tSpends1 <-
|
||||
liftIO $
|
||||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(fromIntegral zats + feeAmt)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
prepTSpends
|
||||
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
||||
tList1
|
||||
sSpends1 <-
|
||||
liftIO $
|
||||
prepSSpends
|
||||
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||
sList1
|
||||
oSpends1 <-
|
||||
liftIO $
|
||||
prepOSpends
|
||||
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
oList1
|
||||
let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
|
||||
outgoing' <-
|
||||
liftIO $
|
||||
makeOutgoing
|
||||
acc
|
||||
recipients
|
||||
(noteTotal1 - fee - fromIntegral zats)
|
||||
policy
|
||||
case finalNotePlan of
|
||||
Right (tList1, sList1, oList1) -> do
|
||||
logDebugN $
|
||||
T.pack $ "selected notes with fee" ++ show feeAmt
|
||||
logDebugN $ T.pack $ show tList1
|
||||
logDebugN $ T.pack $ show sList1
|
||||
logDebugN $ T.pack $ show oList1
|
||||
tSpends1 <-
|
||||
liftIO $
|
||||
prepTSpends
|
||||
(getTranSK $
|
||||
zcashAccountTPrivateKey $ entityVal acc)
|
||||
tList1
|
||||
sSpends1 <-
|
||||
liftIO $
|
||||
prepSSpends
|
||||
(getSapSK $
|
||||
zcashAccountSapSpendKey $ entityVal acc)
|
||||
sList1
|
||||
oSpends1 <-
|
||||
liftIO $
|
||||
prepOSpends
|
||||
(getOrchSK $
|
||||
zcashAccountOrchSpendKey $ entityVal acc)
|
||||
oList1
|
||||
let noteTotal1 =
|
||||
getTotalAmount (tList1, sList1, oList1)
|
||||
outgoing' <-
|
||||
liftIO $
|
||||
makeOutgoing
|
||||
acc
|
||||
recipients
|
||||
(noteTotal1 - feeAmt - fromIntegral zats)
|
||||
policy
|
||||
logDebugN $ T.pack $ show outgoing'
|
||||
case outgoing' of
|
||||
Left e -> return $ Left e
|
||||
Right outgoing -> do
|
||||
let tx =
|
||||
createTransaction
|
||||
Nothing
|
||||
Nothing
|
||||
tSpends1
|
||||
sSpends1
|
||||
oSpends1
|
||||
outgoing
|
||||
zn
|
||||
bh
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
logDebugN $ T.pack $ show outgoing'
|
||||
case outgoing' of
|
||||
Left e -> return $ Left e
|
||||
Right outgoing -> do
|
||||
tx <-
|
||||
liftIO $
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends1
|
||||
sSpends1
|
||||
oSpends1
|
||||
outgoing
|
||||
zn
|
||||
bh
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
Left e -> return $ Left e
|
||||
Left e -> do
|
||||
logErrorN $ T.pack $ show e
|
||||
return $ Left e
|
||||
|
|
|
|||
771
test/Spec.hs
771
test/Spec.hs
|
|
@ -37,7 +37,7 @@ import ZcashHaskell.Types
|
|||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (makeZebraCall, readZebraTransaction)
|
||||
import ZcashHaskell.Utils (f4Jumble, makeZebraCall, readZebraTransaction)
|
||||
import Zenith.Core
|
||||
import Zenith.DB
|
||||
import Zenith.Types
|
||||
|
|
@ -204,395 +204,380 @@ main = do
|
|||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
|
||||
oNotes `shouldBe` []
|
||||
describe "Creating Tx" $ do
|
||||
describe "Full" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 3)
|
||||
3026170
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldBe` (hexString "deadbeef")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError "Receiver not capable of Full privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Combination of receivers not allowed for Full privacy")
|
||||
describe "Medium" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError "Receiver not capable of Medium privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "Low" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "None" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "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
|
||||
describe "Creating Tx" $ do
|
||||
describe "Full" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 3)
|
||||
3026170
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left (PrivacyPolicyError "Receiver not capable of Full privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Combination of receivers not allowed for Full privacy")
|
||||
describe "Medium" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "00")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError "Receiver not capable of Medium privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "Low" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "None" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
Subproject commit 662a0d1148d3f52e2683157a4c9280bb8e81b0cb
|
||||
Subproject commit 6d4b6840d30fe1631902acd0388bef0040fee9e8
|
||||
|
|
@ -141,6 +141,7 @@ test-suite zenith-tests
|
|||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, bytestring
|
||||
, aeson
|
||||
, configurator
|
||||
, monad-logger
|
||||
, data-default
|
||||
|
|
|
|||
Loading…
Reference in a new issue