Compare commits
2 commits
86b881e752
...
acba134de2
| Author | SHA1 | Date | |
|---|---|---|---|
acba134de2
|
|||
|
a0b9d4178a
|
8 changed files with 652 additions and 295 deletions
|
|
@ -26,7 +26,7 @@ import qualified Data.ByteString.Lazy as LBS
|
|||
import Data.Digest.Pure.MD5
|
||||
import Data.HexString (HexString, hexString, toBytes, toText)
|
||||
import Data.List
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import Data.Pool (Pool)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
|
|
@ -34,7 +34,11 @@ import Data.Time
|
|||
import qualified Database.Esqueleto.Experimental as ESQ
|
||||
import Database.Persist
|
||||
import Database.Persist.Sqlite
|
||||
import GHC.Float.RealFracMethods (floorFloatInteger)
|
||||
import GHC.Float.RealFracMethods
|
||||
( ceilingFloatInteger
|
||||
, floorFloatInt
|
||||
, floorFloatInteger
|
||||
)
|
||||
import Haskoin.Crypto.Keys (XPrvKey(..))
|
||||
import Lens.Micro ((&), (.~), (^.), set)
|
||||
import Network.HTTP.Client
|
||||
|
|
@ -75,11 +79,13 @@ import Zenith.Types
|
|||
, OrchardSpendingKeyDB(..)
|
||||
, PhraseDB(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
, RseedDB(..)
|
||||
, SaplingSpendingKeyDB(..)
|
||||
, ScopeDB(..)
|
||||
, TransparentSpendingKeyDB(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ValidAddressAPI(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZebraTreeInfo(..)
|
||||
)
|
||||
|
|
@ -541,7 +547,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
|||
return $ Left ZHError
|
||||
Just acc -> do
|
||||
logDebugN $ T.pack $ show acc
|
||||
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
|
||||
let zats = floorFloatInteger $ amt * (10 ^ 8)
|
||||
logDebugN $ T.pack $ show zats
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--let fee = calculateTxFee firstPass $ fst recipient
|
||||
|
|
@ -729,38 +735,13 @@ prepareTxV2 ::
|
|||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Float
|
||||
-> ValidAddress
|
||||
-> T.Text
|
||||
-> [ProposedNote]
|
||||
-> PrivacyPolicy
|
||||
-> LoggingT IO (Either TxError HexString)
|
||||
prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
||||
-> NoLoggingT IO (Either TxError HexString)
|
||||
prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||
accRead <- liftIO $ getAccountById pool za
|
||||
let recipient =
|
||||
case va of
|
||||
Unified ua ->
|
||||
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)
|
||||
Sapling sa -> (3, getBytes $ sa_receiver sa)
|
||||
Transparent ta ->
|
||||
case tr_type (ta_receiver ta) of
|
||||
P2PKH -> (1, toBytes $ tr_bytes (ta_receiver ta))
|
||||
P2SH -> (2, toBytes $ tr_bytes (ta_receiver ta))
|
||||
Exchange ea ->
|
||||
case tr_type (ex_address ea) of
|
||||
P2PKH -> (1, toBytes $ tr_bytes (ex_address ea))
|
||||
P2SH -> (2, toBytes $ tr_bytes (ex_address ea))
|
||||
logDebugN $ T.pack $ show recipient
|
||||
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
|
||||
|
|
@ -771,14 +752,21 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
|||
return $ Left ZHError
|
||||
Just acc -> do
|
||||
logDebugN $ T.pack $ show acc
|
||||
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
|
||||
logDebugN $ T.pack $ show zats
|
||||
let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes
|
||||
let zats = ceilingFloatInteger $ amt * (10 ^ 8)
|
||||
logDebugN $ "amt: " <> T.pack (show amt)
|
||||
logDebugN $ "zats: " <> T.pack (show zats)
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--let fee = calculateTxFee firstPass $ fst recipient
|
||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
notePlan <-
|
||||
liftIO $
|
||||
selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy
|
||||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(zats + 10000)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
policy
|
||||
case notePlan of
|
||||
Right (tList, sList, oList) -> do
|
||||
logDebugN "selected notes"
|
||||
|
|
@ -786,6 +774,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
|||
logDebugN $ T.pack $ show sList
|
||||
logDebugN $ T.pack $ show oList
|
||||
let noteTotal = getTotalAmount (tList, sList, oList)
|
||||
logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
|
||||
tSpends <-
|
||||
liftIO $
|
||||
prepTSpends
|
||||
|
|
@ -806,7 +795,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
|||
--print oSpends
|
||||
dummy' <-
|
||||
liftIO $
|
||||
makeOutgoing acc recipient zats (noteTotal - 5000 - zats) policy
|
||||
makeOutgoing acc recipients (noteTotal - 5000 - zats) policy
|
||||
case dummy' of
|
||||
Left e -> return $ Left e
|
||||
Right dummy -> do
|
||||
|
|
@ -834,7 +823,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
|||
pool
|
||||
za
|
||||
(zats + feeAmt)
|
||||
(fst recipient)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
policy
|
||||
case finalNotePlan of
|
||||
Right (tList1, sList1, oList1) -> do
|
||||
|
|
@ -863,8 +852,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
|||
liftIO $
|
||||
makeOutgoing
|
||||
acc
|
||||
recipient
|
||||
zats
|
||||
recipients
|
||||
(noteTotal1 - feeAmt - zats)
|
||||
policy
|
||||
logDebugN $ T.pack $ show outgoing'
|
||||
|
|
@ -889,30 +877,135 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
|||
logErrorN $ T.pack $ show e
|
||||
return $ Left e
|
||||
where
|
||||
extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int, T.Text)
|
||||
extractReceiver (ProposedNote (ValidAddressAPI va) amt m) =
|
||||
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
|
||||
in case va of
|
||||
Unified ua ->
|
||||
case o_rec ua of
|
||||
Nothing ->
|
||||
case s_rec ua of
|
||||
Nothing ->
|
||||
case t_rec ua of
|
||||
Nothing -> (0, "", 0, "")
|
||||
Just r3 ->
|
||||
case tr_type r3 of
|
||||
P2PKH ->
|
||||
(1, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
|
||||
P2SH ->
|
||||
(2, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
|
||||
Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
|
||||
Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
|
||||
Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
|
||||
Transparent ta ->
|
||||
case tr_type (ta_receiver ta) of
|
||||
P2PKH ->
|
||||
(1, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
|
||||
P2SH ->
|
||||
(2, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
|
||||
Exchange ea ->
|
||||
case tr_type (ex_address ea) of
|
||||
P2PKH ->
|
||||
(5, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
|
||||
P2SH ->
|
||||
(6, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
|
||||
prepareOutgoingNote ::
|
||||
ZcashAccount -> (Int, BS.ByteString, Int, T.Text) -> OutgoingNote
|
||||
prepareOutgoingNote zac (k, r, a, m) =
|
||||
OutgoingNote
|
||||
(if k == 5
|
||||
then 1
|
||||
else if k == 6
|
||||
then 2
|
||||
else fromIntegral k)
|
||||
(case k of
|
||||
4 -> getBytes $ getOrchSK $ zcashAccountOrchSpendKey zac
|
||||
3 -> getBytes $ getSapSK $ zcashAccountSapSpendKey zac
|
||||
_anyOther -> BS.empty)
|
||||
r
|
||||
(fromIntegral a)
|
||||
(E.encodeUtf8 m)
|
||||
False
|
||||
makeOutgoing ::
|
||||
Entity ZcashAccount
|
||||
-> (Int, BS.ByteString)
|
||||
-> Integer
|
||||
-> [(Int, BS.ByteString, Int, T.Text)]
|
||||
-> Integer
|
||||
-> PrivacyPolicy
|
||||
-> IO (Either TxError [OutgoingNote])
|
||||
makeOutgoing acc (k, recvr) zats chg policy = do
|
||||
makeOutgoing acc recvs chg pol = do
|
||||
let k = map (\(x, _, _, _) -> x) recvs
|
||||
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||
case k of
|
||||
4 ->
|
||||
case policy of
|
||||
None ->
|
||||
return $
|
||||
Left $
|
||||
PrivacyPolicyError "Receiver not compatible with privacy policy"
|
||||
_anyOther -> do
|
||||
case pol of
|
||||
Full ->
|
||||
if elem 1 k || elem 2 k || elem 5 k || elem 6 k
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy"
|
||||
else if elem 3 k && elem 4 k
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Multiple shielded pulls not allowed for Full privacy"
|
||||
else if 3 `elem` k
|
||||
then do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
s_rec =<<
|
||||
isValidUnifiedAddress
|
||||
(E.encodeUtf8 internalUA)
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
3
|
||||
(getBytes $
|
||||
getSapSK $
|
||||
zcashAccountSapSpendKey $ entityVal acc)
|
||||
(getBytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
let onotes =
|
||||
map
|
||||
(prepareOutgoingNote (entityVal acc))
|
||||
recvs
|
||||
return $ Right $ cnote : onotes
|
||||
else if 4 `elem` k
|
||||
then do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
o_rec =<<
|
||||
isValidUnifiedAddress
|
||||
(E.encodeUtf8 internalUA)
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $
|
||||
getOrchSK $
|
||||
zcashAccountOrchSpendKey $
|
||||
entityVal acc)
|
||||
(getBytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
let onotes =
|
||||
map
|
||||
(prepareOutgoingNote (entityVal acc))
|
||||
recvs
|
||||
return $ Right $ cnote : onotes
|
||||
else return $ Left ZHError
|
||||
Medium ->
|
||||
if elem 1 k || elem 2 k || elem 5 k || elem 6 k
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy"
|
||||
else do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
return $
|
||||
Right
|
||||
[ OutgoingNote
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $
|
||||
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
|
|
@ -920,51 +1013,20 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
|||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
, OutgoingNote
|
||||
4
|
||||
(getBytes $
|
||||
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
recvr
|
||||
(fromIntegral zats)
|
||||
(E.encodeUtf8 memo)
|
||||
False
|
||||
]
|
||||
3 ->
|
||||
case policy of
|
||||
None ->
|
||||
return $
|
||||
Left $
|
||||
PrivacyPolicyError "Receiver not compatible with privacy policy"
|
||||
Full -> do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
s_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
return $
|
||||
Right
|
||||
[ OutgoingNote
|
||||
3
|
||||
(getBytes $
|
||||
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||
(getBytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
, OutgoingNote
|
||||
3
|
||||
(getBytes $
|
||||
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||
recvr
|
||||
(fromIntegral zats)
|
||||
(E.encodeUtf8 memo)
|
||||
False
|
||||
]
|
||||
_anyOther -> do
|
||||
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
|
||||
return $ Right $ cnote : onotes
|
||||
Low ->
|
||||
if elem 5 k || elem 6 k
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy"
|
||||
else do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
return $
|
||||
Right
|
||||
[ OutgoingNote
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $
|
||||
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
|
|
@ -972,58 +1034,28 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
|||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
, OutgoingNote
|
||||
3
|
||||
(getBytes $
|
||||
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||
recvr
|
||||
(fromIntegral zats)
|
||||
(E.encodeUtf8 memo)
|
||||
False
|
||||
]
|
||||
2 ->
|
||||
if policy <= Low
|
||||
then do
|
||||
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
|
||||
return $ Right $ cnote : onotes
|
||||
None ->
|
||||
if elem 3 k || elem 4 k
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy"
|
||||
else do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
return $
|
||||
Right
|
||||
[ OutgoingNote
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
1
|
||||
BS.empty
|
||||
(toBytes $ tr_bytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
, OutgoingNote 2 BS.empty recvr (fromIntegral zats) "" False
|
||||
]
|
||||
else return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy"
|
||||
1 ->
|
||||
if policy <= Low
|
||||
then do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
return $
|
||||
Right
|
||||
[ OutgoingNote
|
||||
1
|
||||
BS.empty
|
||||
(toBytes $ tr_bytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
, OutgoingNote 1 BS.empty recvr (fromIntegral zats) "" False
|
||||
]
|
||||
else return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy"
|
||||
_anyOther -> return $ Left ZHError
|
||||
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
|
||||
return $ Right $ cnote : onotes
|
||||
getTotalAmount ::
|
||||
( [Entity WalletTrNote]
|
||||
, [Entity WalletSapNote]
|
||||
|
|
|
|||
116
src/Zenith/DB.hs
116
src/Zenith/DB.hs
|
|
@ -2080,7 +2080,7 @@ selectUnspentNotesV2 ::
|
|||
ConnectionPool
|
||||
-> ZcashAccountId
|
||||
-> Integer
|
||||
-> Int
|
||||
-> [Int]
|
||||
-> PrivacyPolicy
|
||||
-> IO
|
||||
(Either
|
||||
|
|
@ -2091,27 +2091,40 @@ selectUnspentNotesV2 ::
|
|||
selectUnspentNotesV2 pool za amt recv policy = do
|
||||
case policy of
|
||||
Full ->
|
||||
case recv of
|
||||
4 -> do
|
||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
||||
if a1 > 0
|
||||
then return $
|
||||
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
|
||||
else return $ Right ([], [], oList)
|
||||
3 -> do
|
||||
sapNotes <- getWalletUnspentSapNotes pool za
|
||||
let (a2, sList) = checkSapling (fromIntegral amt) sapNotes
|
||||
if a2 > 0
|
||||
then return $
|
||||
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
|
||||
else return $ Right ([], sList, [])
|
||||
_anyOther ->
|
||||
return $
|
||||
Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
|
||||
if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv
|
||||
then return $
|
||||
Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
|
||||
else if elem 4 recv && elem 3 recv
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Combination of receivers not allowed for Full privacy"
|
||||
else if 4 `elem` recv
|
||||
then do
|
||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||
let (a1, oList) =
|
||||
checkOrchard (fromIntegral amt) orchNotes
|
||||
if a1 > 0
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Not enough notes for Full privacy"
|
||||
else return $ Right ([], [], oList)
|
||||
else do
|
||||
sapNotes <- getWalletUnspentSapNotes pool za
|
||||
let (a2, sList) =
|
||||
checkSapling (fromIntegral amt) sapNotes
|
||||
if a2 > 0
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Not enough notes for Full privacy"
|
||||
else return $ Right ([], sList, [])
|
||||
Medium ->
|
||||
if recv > 2
|
||||
then do
|
||||
if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv
|
||||
then return $
|
||||
Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
|
||||
else do
|
||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
||||
if a1 > 0
|
||||
|
|
@ -2124,27 +2137,16 @@ selectUnspentNotesV2 pool za amt recv policy = do
|
|||
PrivacyPolicyError "Not enough notes for Medium privacy"
|
||||
else return $ Right ([], sList, oList)
|
||||
else return $ Right ([], [], oList)
|
||||
else return $
|
||||
Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
|
||||
Low ->
|
||||
if recv == 0
|
||||
if 0 `elem` recv
|
||||
then return $ Left ZHError
|
||||
else do
|
||||
case recv of
|
||||
3 -> do
|
||||
sapNotes <- getWalletUnspentSapNotes pool za
|
||||
let (a1, sList) = checkSapling (fromIntegral amt) sapNotes
|
||||
if a1 > 0
|
||||
then do
|
||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||
let (a2, oList) = checkOrchard a1 orchNotes
|
||||
if a2 > 0
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError "Not enough notes for Low privacy"
|
||||
else return $ Right ([], sList, oList)
|
||||
else return $ Right ([], sList, [])
|
||||
_anyOther -> do
|
||||
if elem 5 recv || elem 6 recv
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Exchange addresses not supported with Low privacy"
|
||||
else do
|
||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
||||
if a1 > 0
|
||||
|
|
@ -2152,27 +2154,27 @@ selectUnspentNotesV2 pool za amt recv policy = do
|
|||
sapNotes <- getWalletUnspentSapNotes pool za
|
||||
let (a2, sList) = checkSapling a1 sapNotes
|
||||
if a2 > 0
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError "Not enough notes for Low privacy"
|
||||
then do
|
||||
trNotes <- getWalletUnspentTrNotes pool za
|
||||
let (a3, tList) = checkTransparent a2 trNotes
|
||||
if a3 > 0
|
||||
then return $ Left InsufficientFunds
|
||||
else return $ Right (tList, sList, oList)
|
||||
else return $ Right ([], sList, oList)
|
||||
else return $ Right ([], [], oList)
|
||||
None -> do
|
||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
||||
if a1 > 0
|
||||
then do
|
||||
sapNotes <- getWalletUnspentSapNotes pool za
|
||||
let (a2, sList) = checkSapling a1 sapNotes
|
||||
if a2 > 0
|
||||
then do
|
||||
trNotes <- getWalletUnspentTrNotes pool za
|
||||
let (a3, tList) = checkTransparent a2 trNotes
|
||||
if a3 > 0
|
||||
then return $ Left InsufficientFunds
|
||||
else return $ Right (tList, sList, oList)
|
||||
else return $ Right ([], sList, oList)
|
||||
else return $ Right ([], [], oList)
|
||||
if elem 3 recv || elem 4 recv
|
||||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy."
|
||||
else do
|
||||
trNotes <- getWalletUnspentTrNotes pool za
|
||||
let (a3, tList) = checkTransparent (fromIntegral amt) trNotes
|
||||
if a3 > 0
|
||||
then return $
|
||||
Left $ PrivacyPolicyError "Insufficient transparent funds"
|
||||
else return $ Right (tList, [], [])
|
||||
where
|
||||
checkTransparent ::
|
||||
Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
|
||||
|
|
|
|||
|
|
@ -1557,8 +1557,16 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
|
|||
let zPort = c_zebraPort config
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
res <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2 pool zHost zPort znet accId bl amt addr memo policy
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
zPort
|
||||
znet
|
||||
accId
|
||||
bl
|
||||
[ProposedNote (ValidAddressAPI addr) amt (Just memo)]
|
||||
policy
|
||||
case res of
|
||||
Left e -> sendMsg $ ShowError $ T.pack $ show e
|
||||
Right rawTx -> do
|
||||
|
|
|
|||
|
|
@ -8,18 +8,23 @@
|
|||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
|
||||
module Zenith.RPC where
|
||||
|
||||
import Control.Concurrent (forkIO)
|
||||
import Control.Exception (try)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger (runNoLoggingT)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import qualified Data.HexString as H
|
||||
import Data.Int
|
||||
import Data.Scientific (floatingOrInteger)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import qualified Data.UUID as U
|
||||
import Data.UUID.V4 (nextRandom)
|
||||
import qualified Data.Vector as V
|
||||
import Database.Esqueleto.Experimental
|
||||
( entityKey
|
||||
|
|
@ -32,17 +37,20 @@ import Text.Read (readMaybe)
|
|||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import ZcashHaskell.Orchard (parseAddress)
|
||||
import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
|
||||
import Zenith.Core (createCustomWalletAddress, createZcashAccount)
|
||||
import ZcashHaskell.Utils (makeZebraCall)
|
||||
import Zenith.Core (createCustomWalletAddress, createZcashAccount, prepareTxV2)
|
||||
import Zenith.DB
|
||||
( Operation(..)
|
||||
, ZcashAccount(..)
|
||||
, ZcashWallet(..)
|
||||
, finalizeOperation
|
||||
, findNotesByAddress
|
||||
, getAccountById
|
||||
, getAccounts
|
||||
, getAddressById
|
||||
, getAddresses
|
||||
, getExternalAddresses
|
||||
, getLastSyncBlock
|
||||
, getMaxAccount
|
||||
, getMaxAddress
|
||||
, getOperation
|
||||
|
|
@ -53,6 +61,7 @@ import Zenith.DB
|
|||
, initPool
|
||||
, saveAccount
|
||||
, saveAddress
|
||||
, saveOperation
|
||||
, saveWallet
|
||||
, toZcashAccountAPI
|
||||
, toZcashAddressAPI
|
||||
|
|
@ -63,11 +72,15 @@ import Zenith.Types
|
|||
( AccountBalance(..)
|
||||
, Config(..)
|
||||
, PhraseDB(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
, ValidAddressAPI(..)
|
||||
, ZcashAccountAPI(..)
|
||||
, ZcashAddressAPI(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZcashNoteAPI(..)
|
||||
, ZcashWalletAPI(..)
|
||||
, ZenithStatus(..)
|
||||
, ZenithUuid(..)
|
||||
)
|
||||
import Zenith.Utils (jsonNumber)
|
||||
|
|
@ -83,6 +96,7 @@ data ZenithMethod
|
|||
| GetNewAccount
|
||||
| GetNewAddress
|
||||
| GetOperationStatus
|
||||
| SendMany
|
||||
| UnknownMethod
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
|
|
@ -97,6 +111,7 @@ instance ToJSON ZenithMethod where
|
|||
toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
|
||||
toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
|
||||
toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
|
||||
toJSON SendMany = Data.Aeson.String "sendmany"
|
||||
toJSON UnknownMethod = Data.Aeson.Null
|
||||
|
||||
instance FromJSON ZenithMethod where
|
||||
|
|
@ -112,6 +127,7 @@ instance FromJSON ZenithMethod where
|
|||
"getnewaccount" -> pure GetNewAccount
|
||||
"getnewaddress" -> pure GetNewAddress
|
||||
"getoperationstatus" -> pure GetOperationStatus
|
||||
"sendmany" -> pure SendMany
|
||||
_ -> pure UnknownMethod
|
||||
|
||||
data ZenithParams
|
||||
|
|
@ -125,6 +141,7 @@ data ZenithParams
|
|||
| NameIdParams !T.Text !Int
|
||||
| NewAddrParams !Int !T.Text !Bool !Bool
|
||||
| OpParams !ZenithUuid
|
||||
| SendParams !Int ![ProposedNote] !PrivacyPolicy
|
||||
| TestParams !T.Text
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
|
|
@ -148,6 +165,8 @@ instance ToJSON ZenithParams where
|
|||
[Data.Aeson.String "ExcludeTransparent" | t]
|
||||
toJSON (OpParams i) =
|
||||
Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
|
||||
toJSON (SendParams i ns p) =
|
||||
Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p]
|
||||
|
||||
data ZenithResponse
|
||||
= InfoResponse !T.Text !ZenithInfo
|
||||
|
|
@ -159,6 +178,7 @@ data ZenithResponse
|
|||
| NewItemResponse !T.Text !Int64
|
||||
| NewAddrResponse !T.Text !ZcashAddressAPI
|
||||
| OpResponse !T.Text !Operation
|
||||
| SendResponse !T.Text !U.UUID
|
||||
| ErrorResponse !T.Text !Double !T.Text
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
|
|
@ -179,6 +199,7 @@ instance ToJSON ZenithResponse where
|
|||
toJSON (NewItemResponse i ix) = packRpcResponse i ix
|
||||
toJSON (NewAddrResponse i a) = packRpcResponse i a
|
||||
toJSON (OpResponse i u) = packRpcResponse i u
|
||||
toJSON (SendResponse i o) = packRpcResponse i o
|
||||
|
||||
instance FromJSON ZenithResponse where
|
||||
parseJSON =
|
||||
|
|
@ -258,6 +279,10 @@ instance FromJSON ZenithResponse where
|
|||
case floatingOrInteger k of
|
||||
Left _e -> fail "Unknown value"
|
||||
Right k' -> pure $ NewItemResponse i k'
|
||||
String s -> do
|
||||
case U.fromText s of
|
||||
Nothing -> fail "Unknown value"
|
||||
Just u -> pure $ SendResponse i u
|
||||
_anyOther -> fail "Malformed JSON"
|
||||
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
|
||||
|
||||
|
|
@ -416,6 +441,30 @@ instance FromJSON RpcCall where
|
|||
Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
|
||||
else pure $ RpcCall v i GetOperationStatus BadParams
|
||||
_anyOther -> pure $ RpcCall v i GetOperationStatus BadParams
|
||||
SendMany -> do
|
||||
p <- obj .: "params"
|
||||
case p of
|
||||
Array a ->
|
||||
if V.length a >= 2
|
||||
then do
|
||||
acc <- parseJSON $ a V.! 0
|
||||
x <- parseJSON $ a V.! 1
|
||||
case x of
|
||||
String _ -> do
|
||||
x' <- parseJSON $ a V.! 1
|
||||
y <- parseJSON $ a V.! 2
|
||||
if not (null y)
|
||||
then pure $ RpcCall v i SendMany (SendParams acc y x')
|
||||
else pure $ RpcCall v i SendMany BadParams
|
||||
Array _ -> do
|
||||
x' <- parseJSON $ a V.! 1
|
||||
if not (null x')
|
||||
then pure $
|
||||
RpcCall v i SendMany (SendParams acc x' Full)
|
||||
else pure $ RpcCall v i SendMany BadParams
|
||||
_anyOther -> pure $ RpcCall v i SendMany BadParams
|
||||
else pure $ RpcCall v i SendMany BadParams
|
||||
_anyOther -> pure $ RpcCall v i SendMany BadParams
|
||||
|
||||
type ZenithRPC
|
||||
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
|
||||
|
|
@ -682,6 +731,75 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
ErrorResponse (callId req) (-32009) "Operation ID not found"
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
SendMany ->
|
||||
case parameters req of
|
||||
SendParams a ns p -> do
|
||||
let dbPath = w_dbPath state
|
||||
let zHost = w_host state
|
||||
let zPort = w_port state
|
||||
let znet = w_network state
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
opid <- liftIO nextRandom
|
||||
startTime <- liftIO getCurrentTime
|
||||
opkey <-
|
||||
liftIO $
|
||||
saveOperation pool $
|
||||
Operation (ZenithUuid opid) startTime Nothing Processing Nothing
|
||||
case opkey of
|
||||
Nothing ->
|
||||
return $ ErrorResponse (callId req) (-32010) "Internal Error"
|
||||
Just opkey' -> do
|
||||
acc <-
|
||||
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
|
||||
case acc of
|
||||
Just acc' -> do
|
||||
bl <-
|
||||
liftIO $
|
||||
getLastSyncBlock
|
||||
pool
|
||||
(zcashAccountWalletId $ entityVal acc')
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $ do
|
||||
res <-
|
||||
liftIO $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
zPort
|
||||
znet
|
||||
(entityKey acc')
|
||||
bl
|
||||
ns
|
||||
p
|
||||
case res of
|
||||
Left e ->
|
||||
finalizeOperation pool opkey' Failed $
|
||||
T.pack $ show e
|
||||
Right rawTx -> do
|
||||
zebraRes <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"sendrawtransaction"
|
||||
[Data.Aeson.String $ H.toText rawTx]
|
||||
case zebraRes of
|
||||
Left e1 ->
|
||||
finalizeOperation pool opkey' Failed $
|
||||
T.pack $ show e1
|
||||
Right txId ->
|
||||
finalizeOperation pool opkey' Successful $
|
||||
"Tx ID: " <> H.toText txId
|
||||
return $ SendResponse (callId req) opid
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32006)
|
||||
"Account does not exist."
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
|
||||
authenticate :: Config -> BasicAuthCheck Bool
|
||||
authenticate config = BasicAuthCheck check
|
||||
|
|
|
|||
|
|
@ -23,13 +23,23 @@ import Data.Text.Encoding.Error (lenientDecode)
|
|||
import qualified Data.UUID as U
|
||||
import Database.Persist.TH
|
||||
import GHC.Generics
|
||||
import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
|
||||
import ZcashHaskell.Sapling (encodeSaplingAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( encodeExchangeAddress
|
||||
, encodeTransparentReceiver
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
( OrchardSpendingKey(..)
|
||||
( ExchangeAddress(..)
|
||||
, OrchardSpendingKey(..)
|
||||
, Phrase(..)
|
||||
, Rseed(..)
|
||||
, SaplingAddress(..)
|
||||
, SaplingSpendingKey(..)
|
||||
, Scope(..)
|
||||
, TransparentAddress(..)
|
||||
, TransparentSpendingKey
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
|
||||
|
|
@ -207,6 +217,51 @@ data PrivacyPolicy
|
|||
|
||||
$(deriveJSON defaultOptions ''PrivacyPolicy)
|
||||
|
||||
newtype ValidAddressAPI = ValidAddressAPI
|
||||
{ getVA :: ValidAddress
|
||||
} deriving newtype (Eq, Show)
|
||||
|
||||
instance ToJSON ValidAddressAPI where
|
||||
toJSON (ValidAddressAPI va) =
|
||||
case va of
|
||||
Unified ua -> Data.Aeson.String $ encodeUnifiedAddress ua
|
||||
Sapling sa ->
|
||||
maybe
|
||||
Data.Aeson.Null
|
||||
Data.Aeson.String
|
||||
(encodeSaplingAddress (net_type sa) (sa_receiver sa))
|
||||
Transparent ta ->
|
||||
Data.Aeson.String $
|
||||
encodeTransparentReceiver (ta_network ta) (ta_receiver ta)
|
||||
Exchange ea ->
|
||||
maybe
|
||||
Data.Aeson.Null
|
||||
Data.Aeson.String
|
||||
(encodeExchangeAddress (ex_network ea) (ex_address ea))
|
||||
|
||||
data ProposedNote = ProposedNote
|
||||
{ pn_addr :: !ValidAddressAPI
|
||||
, pn_amt :: !Float
|
||||
, pn_memo :: !(Maybe T.Text)
|
||||
} deriving (Eq, Prelude.Show)
|
||||
|
||||
instance FromJSON ProposedNote where
|
||||
parseJSON =
|
||||
withObject "ProposedNote" $ \obj -> do
|
||||
a <- obj .: "address"
|
||||
n <- obj .: "amount"
|
||||
m <- obj .:? "memo"
|
||||
case parseAddress (E.encodeUtf8 a) of
|
||||
Nothing -> fail "Invalid address"
|
||||
Just a' ->
|
||||
if n > 0 && n < 21000000
|
||||
then pure $ ProposedNote (ValidAddressAPI a') n m
|
||||
else fail "Invalid amount"
|
||||
|
||||
instance ToJSON ProposedNote where
|
||||
toJSON (ProposedNote a n m) =
|
||||
object ["address" .= a, "amount" .= n, "memo" .= m]
|
||||
|
||||
-- ** `zebrad`
|
||||
-- | Type for modeling the tree state response
|
||||
data ZebraTreeInfo = ZebraTreeInfo
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ import Control.Monad.Logger (runNoLoggingT)
|
|||
import Data.Aeson
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Configurator
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
|
|
@ -18,7 +18,7 @@ import Servant
|
|||
import System.Directory
|
||||
import Test.HUnit hiding (State)
|
||||
import Test.Hspec
|
||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||
import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
|
||||
import ZcashHaskell.Types
|
||||
( ZcashNet(..)
|
||||
, ZebraGetBlockChainInfo(..)
|
||||
|
|
@ -39,6 +39,9 @@ import Zenith.RPC
|
|||
)
|
||||
import Zenith.Types
|
||||
( Config(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
, ValidAddressAPI(..)
|
||||
, ZcashAccountAPI(..)
|
||||
, ZcashAddressAPI(..)
|
||||
, ZcashWalletAPI(..)
|
||||
|
|
@ -572,6 +575,107 @@ main = do
|
|||
Left e -> assertFailure e
|
||||
Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
|
||||
Right _ -> assertFailure "unexpected response"
|
||||
describe "Send tx" $ do
|
||||
describe "sendmany" $ do
|
||||
it "bad credentials" $ do
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
"baduser"
|
||||
"idontknow"
|
||||
SendMany
|
||||
BlankParams
|
||||
res `shouldBe` Left "Invalid credentials"
|
||||
describe "correct credentials" $ do
|
||||
it "invalid account" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams
|
||||
17
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "A cool memo")
|
||||
]
|
||||
Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
|
||||
it "valid account, empty notes" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams 1 [] Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
|
||||
it "valid account, single output" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams
|
||||
1
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
5.0
|
||||
(Just "A cool memo")
|
||||
]
|
||||
Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (SendResponse i o) -> o `shouldNotBe` U.nil
|
||||
it "valid account, multiple outputs" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams
|
||||
1
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
5.0
|
||||
(Just "A cool memo")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
1.0
|
||||
(Just "Not so cool memo")
|
||||
]
|
||||
Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (SendResponse i o) -> o `shouldNotBe` U.nil
|
||||
|
||||
startAPI :: Config -> IO ()
|
||||
startAPI config = do
|
||||
|
|
|
|||
220
test/Spec.hs
220
test/Spec.hs
|
|
@ -123,55 +123,6 @@ main = do
|
|||
let ua =
|
||||
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
|
||||
isValidUnifiedAddress ua `shouldNotBe` Nothing
|
||||
describe "Function tests" $ do
|
||||
describe "Sapling Decoding" $ do
|
||||
let sk =
|
||||
SaplingSpendingKey
|
||||
"\ETX}\195.\SUB\NUL\NUL\NUL\128\NUL\203\"\229IL\CANJ*\209\EM\145\228m\172\&4\SYNNl\DC3\161\147\SO\157\238H\192\147eQ\143L\201\216\163\180\147\145\156Zs+\146>8\176`ta\161\223\SO\140\177\b;\161\SO\236\151W\148<\STX\171|\DC2\172U\195(I\140\146\214\182\137\211\228\159\128~bV\STXy{m'\224\175\221\219\180!\ENQ_\161\132\240?\255\236\"6\133\181\170t\181\139\143\207\170\211\ENQ\167a\184\163\243\246\140\158t\155\133\138X\a\241\200\140\EMT\GS~\175\249&z\250\214\231\239mi\223\206\STX\t\EM<{V~J\253FB"
|
||||
let tree =
|
||||
SaplingCommitmentTree $
|
||||
hexString
|
||||
"01818f2bd58b1e392334d0565181cc7843ae09e3533b2a50a8f1131af657340a5c001001161f962245812ba5e1804fd0a336bc78fa4ee4441a8e0f1525ca5da1b285d35101120f45afa700b8c1854aa8b9c8fe8ed92118ef790584bfcb926078812a10c83a00000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
|
||||
let nextTree =
|
||||
SaplingCommitmentTree $
|
||||
hexString
|
||||
"01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e4900100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
|
||||
it "Sapling is decoded correctly" $ do
|
||||
so <-
|
||||
runSqlite "zenith.db" $
|
||||
selectList [ShieldOutputTx ==. toSqlKey 38318] []
|
||||
let cmus = map (getHex . shieldOutputCmu . entityVal) so
|
||||
let pos =
|
||||
getSaplingNotePosition <$>
|
||||
(getSaplingWitness =<<
|
||||
updateSaplingCommitmentTree tree (head cmus))
|
||||
let pos1 = getSaplingNotePosition <$> getSaplingWitness tree
|
||||
let pos2 = getSaplingNotePosition <$> getSaplingWitness nextTree
|
||||
case pos of
|
||||
Nothing -> assertFailure "couldn't get note position"
|
||||
Just p -> do
|
||||
print p
|
||||
print pos1
|
||||
print pos2
|
||||
let dn =
|
||||
decodeSaplingOutputEsk
|
||||
sk
|
||||
(ShieldedOutput
|
||||
(getHex $ shieldOutputCv $ entityVal $ head so)
|
||||
(getHex $ shieldOutputCmu $ entityVal $ head so)
|
||||
(getHex $ shieldOutputEphKey $ entityVal $ head so)
|
||||
(getHex $ shieldOutputEncCipher $ entityVal $ head so)
|
||||
(getHex $ shieldOutputOutCipher $ entityVal $ head so)
|
||||
(getHex $ shieldOutputProof $ entityVal $ head so))
|
||||
TestNet
|
||||
External
|
||||
p
|
||||
case dn of
|
||||
Nothing -> assertFailure "couldn't decode Sap output"
|
||||
Just d ->
|
||||
a_nullifier d `shouldBe`
|
||||
hexString
|
||||
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
|
||||
describe "Note selection for Tx" $ do
|
||||
it "Value less than balance" $ do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
|
|
@ -181,10 +132,6 @@ main = do
|
|||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
|
||||
res `shouldThrow` anyIOException
|
||||
it "Fee calculation" $ do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
||||
calculateTxFee res 3 `shouldBe` 20000
|
||||
describe "Testing validation" $ do
|
||||
it "Unified" $ do
|
||||
let a =
|
||||
|
|
@ -267,9 +214,11 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
|
@ -291,9 +240,11 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to sapling"
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
|
@ -313,13 +264,49 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
""
|
||||
[ 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 =
|
||||
|
|
@ -338,9 +325,11 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
|
@ -362,9 +351,11 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
|
@ -384,13 +375,48 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
""
|
||||
[ 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 =
|
||||
|
|
@ -409,9 +435,11 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
|
@ -433,9 +461,11 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
|
@ -455,9 +485,11 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
""
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
|
@ -480,14 +512,16 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy")
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
|
|
@ -505,14 +539,16 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
"Sending memo to orchard"
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Receiver not compatible with privacy policy")
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
|
|
@ -528,9 +564,11 @@ main = do
|
|||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
0.005
|
||||
(fromJust uaRead)
|
||||
""
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
|
|
|
|||
|
|
@ -746,7 +746,7 @@
|
|||
"PrivacyPolicy": {
|
||||
"name": "Privacy Policy",
|
||||
"summary": "The chosen privacy policy to use for the transaction",
|
||||
"description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools. `Low` allows deshielding transactions into transparent receivers. `None` allows for transparent funds to be spent to transparent addresses.",
|
||||
"description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools. `Low` allows deshielding transactions into transparent receivers but not to exchange addresses. `None` allows for transparent funds to be spent to transparent addresses and exchange addresses.",
|
||||
"required": false,
|
||||
"schema": {
|
||||
"type": "string",
|
||||
|
|
|
|||
Loading…
Reference in a new issue